{-# LANGUAGE ImplicitParams, RankNTypes, TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- NMClient contains a cache of the objects of NetworkManager\'s D-Bus API.
-- It uses t'GI.GLib.Structs.MainContext.MainContext' and t'GI.Gio.Objects.DBusConnection.DBusConnection' for that and registers to
-- D-Bus signals. That means, when iterating the associated t'GI.GLib.Structs.MainContext.MainContext',
-- D-Bus signals gets processed and the t'GI.NM.Objects.Client.Client' instance updates and
-- emits t'GI.GObject.Objects.Object.Object' signals.

#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif

module GI.NM.Objects.Client
    ( 
#if defined(ENABLE_OVERLOADING)
    ClientCheckpointRollbackFinishMethodInfo,
#endif

-- * Exported types
    Client(..)                              ,
    IsClient                                ,
    toClient                                ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [activateConnectionAsync]("GI.NM.Objects.Client#g:method:activateConnectionAsync"), [activateConnectionFinish]("GI.NM.Objects.Client#g:method:activateConnectionFinish"), [addAndActivateConnection2]("GI.NM.Objects.Client#g:method:addAndActivateConnection2"), [addAndActivateConnection2Finish]("GI.NM.Objects.Client#g:method:addAndActivateConnection2Finish"), [addAndActivateConnectionAsync]("GI.NM.Objects.Client#g:method:addAndActivateConnectionAsync"), [addAndActivateConnectionFinish]("GI.NM.Objects.Client#g:method:addAndActivateConnectionFinish"), [addConnection2]("GI.NM.Objects.Client#g:method:addConnection2"), [addConnection2Finish]("GI.NM.Objects.Client#g:method:addConnection2Finish"), [addConnectionAsync]("GI.NM.Objects.Client#g:method:addConnectionAsync"), [addConnectionFinish]("GI.NM.Objects.Client#g:method:addConnectionFinish"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [checkConnectivity]("GI.NM.Objects.Client#g:method:checkConnectivity"), [checkConnectivityAsync]("GI.NM.Objects.Client#g:method:checkConnectivityAsync"), [checkConnectivityFinish]("GI.NM.Objects.Client#g:method:checkConnectivityFinish"), [checkpointAdjustRollbackTimeout]("GI.NM.Objects.Client#g:method:checkpointAdjustRollbackTimeout"), [checkpointAdjustRollbackTimeoutFinish]("GI.NM.Objects.Client#g:method:checkpointAdjustRollbackTimeoutFinish"), [checkpointCreate]("GI.NM.Objects.Client#g:method:checkpointCreate"), [checkpointCreateFinish]("GI.NM.Objects.Client#g:method:checkpointCreateFinish"), [checkpointDestroy]("GI.NM.Objects.Client#g:method:checkpointDestroy"), [checkpointDestroyFinish]("GI.NM.Objects.Client#g:method:checkpointDestroyFinish"), [checkpointRollback]("GI.NM.Objects.Client#g:method:checkpointRollback"), [checkpointRollbackFinish]("GI.NM.Objects.Client#g:method:checkpointRollbackFinish"), [connectivityCheckGetAvailable]("GI.NM.Objects.Client#g:method:connectivityCheckGetAvailable"), [connectivityCheckGetEnabled]("GI.NM.Objects.Client#g:method:connectivityCheckGetEnabled"), [connectivityCheckGetUri]("GI.NM.Objects.Client#g:method:connectivityCheckGetUri"), [connectivityCheckSetEnabled]("GI.NM.Objects.Client#g:method:connectivityCheckSetEnabled"), [dbusCall]("GI.NM.Objects.Client#g:method:dbusCall"), [dbusCallFinish]("GI.NM.Objects.Client#g:method:dbusCallFinish"), [dbusSetProperty]("GI.NM.Objects.Client#g:method:dbusSetProperty"), [dbusSetPropertyFinish]("GI.NM.Objects.Client#g:method:dbusSetPropertyFinish"), [deactivateConnection]("GI.NM.Objects.Client#g:method:deactivateConnection"), [deactivateConnectionAsync]("GI.NM.Objects.Client#g:method:deactivateConnectionAsync"), [deactivateConnectionFinish]("GI.NM.Objects.Client#g:method:deactivateConnectionFinish"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [init]("GI.Gio.Interfaces.Initable#g:method:init"), [initAsync]("GI.Gio.Interfaces.AsyncInitable#g:method:initAsync"), [initFinish]("GI.Gio.Interfaces.AsyncInitable#g:method:initFinish"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [loadConnections]("GI.NM.Objects.Client#g:method:loadConnections"), [loadConnectionsAsync]("GI.NM.Objects.Client#g:method:loadConnectionsAsync"), [loadConnectionsFinish]("GI.NM.Objects.Client#g:method:loadConnectionsFinish"), [networkingGetEnabled]("GI.NM.Objects.Client#g:method:networkingGetEnabled"), [networkingSetEnabled]("GI.NM.Objects.Client#g:method:networkingSetEnabled"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [reload]("GI.NM.Objects.Client#g:method:reload"), [reloadConnections]("GI.NM.Objects.Client#g:method:reloadConnections"), [reloadConnectionsAsync]("GI.NM.Objects.Client#g:method:reloadConnectionsAsync"), [reloadConnectionsFinish]("GI.NM.Objects.Client#g:method:reloadConnectionsFinish"), [reloadFinish]("GI.NM.Objects.Client#g:method:reloadFinish"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [saveHostname]("GI.NM.Objects.Client#g:method:saveHostname"), [saveHostnameAsync]("GI.NM.Objects.Client#g:method:saveHostnameAsync"), [saveHostnameFinish]("GI.NM.Objects.Client#g:method:saveHostnameFinish"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [waitShutdown]("GI.NM.Objects.Client#g:method:waitShutdown"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure"), [wimaxGetEnabled]("GI.NM.Objects.Client#g:method:wimaxGetEnabled"), [wimaxHardwareGetEnabled]("GI.NM.Objects.Client#g:method:wimaxHardwareGetEnabled"), [wimaxSetEnabled]("GI.NM.Objects.Client#g:method:wimaxSetEnabled"), [wirelessGetEnabled]("GI.NM.Objects.Client#g:method:wirelessGetEnabled"), [wirelessHardwareGetEnabled]("GI.NM.Objects.Client#g:method:wirelessHardwareGetEnabled"), [wirelessSetEnabled]("GI.NM.Objects.Client#g:method:wirelessSetEnabled"), [wwanGetEnabled]("GI.NM.Objects.Client#g:method:wwanGetEnabled"), [wwanHardwareGetEnabled]("GI.NM.Objects.Client#g:method:wwanHardwareGetEnabled"), [wwanSetEnabled]("GI.NM.Objects.Client#g:method:wwanSetEnabled").
-- 
-- ==== Getters
-- [getActivatingConnection]("GI.NM.Objects.Client#g:method:getActivatingConnection"), [getActiveConnections]("GI.NM.Objects.Client#g:method:getActiveConnections"), [getAllDevices]("GI.NM.Objects.Client#g:method:getAllDevices"), [getCapabilities]("GI.NM.Objects.Client#g:method:getCapabilities"), [getCheckpoints]("GI.NM.Objects.Client#g:method:getCheckpoints"), [getConnectionById]("GI.NM.Objects.Client#g:method:getConnectionById"), [getConnectionByPath]("GI.NM.Objects.Client#g:method:getConnectionByPath"), [getConnectionByUuid]("GI.NM.Objects.Client#g:method:getConnectionByUuid"), [getConnections]("GI.NM.Objects.Client#g:method:getConnections"), [getConnectivity]("GI.NM.Objects.Client#g:method:getConnectivity"), [getContextBusyWatcher]("GI.NM.Objects.Client#g:method:getContextBusyWatcher"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDbusConnection]("GI.NM.Objects.Client#g:method:getDbusConnection"), [getDbusNameOwner]("GI.NM.Objects.Client#g:method:getDbusNameOwner"), [getDeviceByIface]("GI.NM.Objects.Client#g:method:getDeviceByIface"), [getDeviceByPath]("GI.NM.Objects.Client#g:method:getDeviceByPath"), [getDevices]("GI.NM.Objects.Client#g:method:getDevices"), [getDnsConfiguration]("GI.NM.Objects.Client#g:method:getDnsConfiguration"), [getDnsMode]("GI.NM.Objects.Client#g:method:getDnsMode"), [getDnsRcManager]("GI.NM.Objects.Client#g:method:getDnsRcManager"), [getInstanceFlags]("GI.NM.Objects.Client#g:method:getInstanceFlags"), [getLogging]("GI.NM.Objects.Client#g:method:getLogging"), [getMainContext]("GI.NM.Objects.Client#g:method:getMainContext"), [getMetered]("GI.NM.Objects.Client#g:method:getMetered"), [getNmRunning]("GI.NM.Objects.Client#g:method:getNmRunning"), [getObjectByPath]("GI.NM.Objects.Client#g:method:getObjectByPath"), [getPermissionResult]("GI.NM.Objects.Client#g:method:getPermissionResult"), [getPermissionsState]("GI.NM.Objects.Client#g:method:getPermissionsState"), [getPrimaryConnection]("GI.NM.Objects.Client#g:method:getPrimaryConnection"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getRadioFlags]("GI.NM.Objects.Client#g:method:getRadioFlags"), [getStartup]("GI.NM.Objects.Client#g:method:getStartup"), [getState]("GI.NM.Objects.Client#g:method:getState"), [getVersion]("GI.NM.Objects.Client#g:method:getVersion"), [getVersionInfo]("GI.NM.Objects.Client#g:method:getVersionInfo").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setLogging]("GI.NM.Objects.Client#g:method:setLogging"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveClientMethod                     ,
#endif

-- ** activateConnectionAsync #method:activateConnectionAsync#

#if defined(ENABLE_OVERLOADING)
    ClientActivateConnectionAsyncMethodInfo ,
#endif
    clientActivateConnectionAsync           ,


-- ** activateConnectionFinish #method:activateConnectionFinish#

#if defined(ENABLE_OVERLOADING)
    ClientActivateConnectionFinishMethodInfo,
#endif
    clientActivateConnectionFinish          ,


-- ** addAndActivateConnection2 #method:addAndActivateConnection2#

#if defined(ENABLE_OVERLOADING)
    ClientAddAndActivateConnection2MethodInfo,
#endif
    clientAddAndActivateConnection2         ,


-- ** addAndActivateConnection2Finish #method:addAndActivateConnection2Finish#

#if defined(ENABLE_OVERLOADING)
    ClientAddAndActivateConnection2FinishMethodInfo,
#endif
    clientAddAndActivateConnection2Finish   ,


-- ** addAndActivateConnectionAsync #method:addAndActivateConnectionAsync#

#if defined(ENABLE_OVERLOADING)
    ClientAddAndActivateConnectionAsyncMethodInfo,
#endif
    clientAddAndActivateConnectionAsync     ,


-- ** addAndActivateConnectionFinish #method:addAndActivateConnectionFinish#

#if defined(ENABLE_OVERLOADING)
    ClientAddAndActivateConnectionFinishMethodInfo,
#endif
    clientAddAndActivateConnectionFinish    ,


-- ** addConnection2 #method:addConnection2#

#if defined(ENABLE_OVERLOADING)
    ClientAddConnection2MethodInfo          ,
#endif
    clientAddConnection2                    ,


-- ** addConnection2Finish #method:addConnection2Finish#

#if defined(ENABLE_OVERLOADING)
    ClientAddConnection2FinishMethodInfo    ,
#endif
    clientAddConnection2Finish              ,


-- ** addConnectionAsync #method:addConnectionAsync#

#if defined(ENABLE_OVERLOADING)
    ClientAddConnectionAsyncMethodInfo      ,
#endif
    clientAddConnectionAsync                ,


-- ** addConnectionFinish #method:addConnectionFinish#

#if defined(ENABLE_OVERLOADING)
    ClientAddConnectionFinishMethodInfo     ,
#endif
    clientAddConnectionFinish               ,


-- ** checkConnectivity #method:checkConnectivity#

#if defined(ENABLE_OVERLOADING)
    ClientCheckConnectivityMethodInfo       ,
#endif
    clientCheckConnectivity                 ,


-- ** checkConnectivityAsync #method:checkConnectivityAsync#

#if defined(ENABLE_OVERLOADING)
    ClientCheckConnectivityAsyncMethodInfo  ,
#endif
    clientCheckConnectivityAsync            ,


-- ** checkConnectivityFinish #method:checkConnectivityFinish#

#if defined(ENABLE_OVERLOADING)
    ClientCheckConnectivityFinishMethodInfo ,
#endif
    clientCheckConnectivityFinish           ,


-- ** checkpointAdjustRollbackTimeout #method:checkpointAdjustRollbackTimeout#

#if defined(ENABLE_OVERLOADING)
    ClientCheckpointAdjustRollbackTimeoutMethodInfo,
#endif
    clientCheckpointAdjustRollbackTimeout   ,


-- ** checkpointAdjustRollbackTimeoutFinish #method:checkpointAdjustRollbackTimeoutFinish#

#if defined(ENABLE_OVERLOADING)
    ClientCheckpointAdjustRollbackTimeoutFinishMethodInfo,
#endif
    clientCheckpointAdjustRollbackTimeoutFinish,


-- ** checkpointCreate #method:checkpointCreate#

#if defined(ENABLE_OVERLOADING)
    ClientCheckpointCreateMethodInfo        ,
#endif
    clientCheckpointCreate                  ,


-- ** checkpointCreateFinish #method:checkpointCreateFinish#

#if defined(ENABLE_OVERLOADING)
    ClientCheckpointCreateFinishMethodInfo  ,
#endif
    clientCheckpointCreateFinish            ,


-- ** checkpointDestroy #method:checkpointDestroy#

#if defined(ENABLE_OVERLOADING)
    ClientCheckpointDestroyMethodInfo       ,
#endif
    clientCheckpointDestroy                 ,


-- ** checkpointDestroyFinish #method:checkpointDestroyFinish#

#if defined(ENABLE_OVERLOADING)
    ClientCheckpointDestroyFinishMethodInfo ,
#endif
    clientCheckpointDestroyFinish           ,


-- ** checkpointRollback #method:checkpointRollback#

#if defined(ENABLE_OVERLOADING)
    ClientCheckpointRollbackMethodInfo      ,
#endif
    clientCheckpointRollback                ,


-- ** connectivityCheckGetAvailable #method:connectivityCheckGetAvailable#

#if defined(ENABLE_OVERLOADING)
    ClientConnectivityCheckGetAvailableMethodInfo,
#endif
    clientConnectivityCheckGetAvailable     ,


-- ** connectivityCheckGetEnabled #method:connectivityCheckGetEnabled#

#if defined(ENABLE_OVERLOADING)
    ClientConnectivityCheckGetEnabledMethodInfo,
#endif
    clientConnectivityCheckGetEnabled       ,


-- ** connectivityCheckGetUri #method:connectivityCheckGetUri#

#if defined(ENABLE_OVERLOADING)
    ClientConnectivityCheckGetUriMethodInfo ,
#endif
    clientConnectivityCheckGetUri           ,


-- ** connectivityCheckSetEnabled #method:connectivityCheckSetEnabled#

#if defined(ENABLE_OVERLOADING)
    ClientConnectivityCheckSetEnabledMethodInfo,
#endif
    clientConnectivityCheckSetEnabled       ,


-- ** dbusCall #method:dbusCall#

#if defined(ENABLE_OVERLOADING)
    ClientDbusCallMethodInfo                ,
#endif
    clientDbusCall                          ,


-- ** dbusCallFinish #method:dbusCallFinish#

#if defined(ENABLE_OVERLOADING)
    ClientDbusCallFinishMethodInfo          ,
#endif
    clientDbusCallFinish                    ,


-- ** dbusSetProperty #method:dbusSetProperty#

#if defined(ENABLE_OVERLOADING)
    ClientDbusSetPropertyMethodInfo         ,
#endif
    clientDbusSetProperty                   ,


-- ** dbusSetPropertyFinish #method:dbusSetPropertyFinish#

#if defined(ENABLE_OVERLOADING)
    ClientDbusSetPropertyFinishMethodInfo   ,
#endif
    clientDbusSetPropertyFinish             ,


-- ** deactivateConnection #method:deactivateConnection#

#if defined(ENABLE_OVERLOADING)
    ClientDeactivateConnectionMethodInfo    ,
#endif
    clientDeactivateConnection              ,


-- ** deactivateConnectionAsync #method:deactivateConnectionAsync#

#if defined(ENABLE_OVERLOADING)
    ClientDeactivateConnectionAsyncMethodInfo,
#endif
    clientDeactivateConnectionAsync         ,


-- ** deactivateConnectionFinish #method:deactivateConnectionFinish#

#if defined(ENABLE_OVERLOADING)
    ClientDeactivateConnectionFinishMethodInfo,
#endif
    clientDeactivateConnectionFinish        ,


-- ** getActivatingConnection #method:getActivatingConnection#

#if defined(ENABLE_OVERLOADING)
    ClientGetActivatingConnectionMethodInfo ,
#endif
    clientGetActivatingConnection           ,


-- ** getActiveConnections #method:getActiveConnections#

#if defined(ENABLE_OVERLOADING)
    ClientGetActiveConnectionsMethodInfo    ,
#endif
    clientGetActiveConnections              ,


-- ** getAllDevices #method:getAllDevices#

#if defined(ENABLE_OVERLOADING)
    ClientGetAllDevicesMethodInfo           ,
#endif
    clientGetAllDevices                     ,


-- ** getCapabilities #method:getCapabilities#

#if defined(ENABLE_OVERLOADING)
    ClientGetCapabilitiesMethodInfo         ,
#endif
    clientGetCapabilities                   ,


-- ** getCheckpoints #method:getCheckpoints#

#if defined(ENABLE_OVERLOADING)
    ClientGetCheckpointsMethodInfo          ,
#endif
    clientGetCheckpoints                    ,


-- ** getConnectionById #method:getConnectionById#

#if defined(ENABLE_OVERLOADING)
    ClientGetConnectionByIdMethodInfo       ,
#endif
    clientGetConnectionById                 ,


-- ** getConnectionByPath #method:getConnectionByPath#

#if defined(ENABLE_OVERLOADING)
    ClientGetConnectionByPathMethodInfo     ,
#endif
    clientGetConnectionByPath               ,


-- ** getConnectionByUuid #method:getConnectionByUuid#

#if defined(ENABLE_OVERLOADING)
    ClientGetConnectionByUuidMethodInfo     ,
#endif
    clientGetConnectionByUuid               ,


-- ** getConnections #method:getConnections#

#if defined(ENABLE_OVERLOADING)
    ClientGetConnectionsMethodInfo          ,
#endif
    clientGetConnections                    ,


-- ** getConnectivity #method:getConnectivity#

#if defined(ENABLE_OVERLOADING)
    ClientGetConnectivityMethodInfo         ,
#endif
    clientGetConnectivity                   ,


-- ** getContextBusyWatcher #method:getContextBusyWatcher#

#if defined(ENABLE_OVERLOADING)
    ClientGetContextBusyWatcherMethodInfo   ,
#endif
    clientGetContextBusyWatcher             ,


-- ** getDbusConnection #method:getDbusConnection#

#if defined(ENABLE_OVERLOADING)
    ClientGetDbusConnectionMethodInfo       ,
#endif
    clientGetDbusConnection                 ,


-- ** getDbusNameOwner #method:getDbusNameOwner#

#if defined(ENABLE_OVERLOADING)
    ClientGetDbusNameOwnerMethodInfo        ,
#endif
    clientGetDbusNameOwner                  ,


-- ** getDeviceByIface #method:getDeviceByIface#

#if defined(ENABLE_OVERLOADING)
    ClientGetDeviceByIfaceMethodInfo        ,
#endif
    clientGetDeviceByIface                  ,


-- ** getDeviceByPath #method:getDeviceByPath#

#if defined(ENABLE_OVERLOADING)
    ClientGetDeviceByPathMethodInfo         ,
#endif
    clientGetDeviceByPath                   ,


-- ** getDevices #method:getDevices#

#if defined(ENABLE_OVERLOADING)
    ClientGetDevicesMethodInfo              ,
#endif
    clientGetDevices                        ,


-- ** getDnsConfiguration #method:getDnsConfiguration#

#if defined(ENABLE_OVERLOADING)
    ClientGetDnsConfigurationMethodInfo     ,
#endif
    clientGetDnsConfiguration               ,


-- ** getDnsMode #method:getDnsMode#

#if defined(ENABLE_OVERLOADING)
    ClientGetDnsModeMethodInfo              ,
#endif
    clientGetDnsMode                        ,


-- ** getDnsRcManager #method:getDnsRcManager#

#if defined(ENABLE_OVERLOADING)
    ClientGetDnsRcManagerMethodInfo         ,
#endif
    clientGetDnsRcManager                   ,


-- ** getInstanceFlags #method:getInstanceFlags#

#if defined(ENABLE_OVERLOADING)
    ClientGetInstanceFlagsMethodInfo        ,
#endif
    clientGetInstanceFlags                  ,


-- ** getLogging #method:getLogging#

#if defined(ENABLE_OVERLOADING)
    ClientGetLoggingMethodInfo              ,
#endif
    clientGetLogging                        ,


-- ** getMainContext #method:getMainContext#

#if defined(ENABLE_OVERLOADING)
    ClientGetMainContextMethodInfo          ,
#endif
    clientGetMainContext                    ,


-- ** getMetered #method:getMetered#

#if defined(ENABLE_OVERLOADING)
    ClientGetMeteredMethodInfo              ,
#endif
    clientGetMetered                        ,


-- ** getNmRunning #method:getNmRunning#

#if defined(ENABLE_OVERLOADING)
    ClientGetNmRunningMethodInfo            ,
#endif
    clientGetNmRunning                      ,


-- ** getObjectByPath #method:getObjectByPath#

#if defined(ENABLE_OVERLOADING)
    ClientGetObjectByPathMethodInfo         ,
#endif
    clientGetObjectByPath                   ,


-- ** getPermissionResult #method:getPermissionResult#

#if defined(ENABLE_OVERLOADING)
    ClientGetPermissionResultMethodInfo     ,
#endif
    clientGetPermissionResult               ,


-- ** getPermissionsState #method:getPermissionsState#

#if defined(ENABLE_OVERLOADING)
    ClientGetPermissionsStateMethodInfo     ,
#endif
    clientGetPermissionsState               ,


-- ** getPrimaryConnection #method:getPrimaryConnection#

#if defined(ENABLE_OVERLOADING)
    ClientGetPrimaryConnectionMethodInfo    ,
#endif
    clientGetPrimaryConnection              ,


-- ** getRadioFlags #method:getRadioFlags#

#if defined(ENABLE_OVERLOADING)
    ClientGetRadioFlagsMethodInfo           ,
#endif
    clientGetRadioFlags                     ,


-- ** getStartup #method:getStartup#

#if defined(ENABLE_OVERLOADING)
    ClientGetStartupMethodInfo              ,
#endif
    clientGetStartup                        ,


-- ** getState #method:getState#

#if defined(ENABLE_OVERLOADING)
    ClientGetStateMethodInfo                ,
#endif
    clientGetState                          ,


-- ** getVersion #method:getVersion#

#if defined(ENABLE_OVERLOADING)
    ClientGetVersionMethodInfo              ,
#endif
    clientGetVersion                        ,


-- ** getVersionInfo #method:getVersionInfo#

#if defined(ENABLE_OVERLOADING)
    ClientGetVersionInfoMethodInfo          ,
#endif
    clientGetVersionInfo                    ,


-- ** loadConnections #method:loadConnections#

#if defined(ENABLE_OVERLOADING)
    ClientLoadConnectionsMethodInfo         ,
#endif
    clientLoadConnections                   ,


-- ** loadConnectionsAsync #method:loadConnectionsAsync#

#if defined(ENABLE_OVERLOADING)
    ClientLoadConnectionsAsyncMethodInfo    ,
#endif
    clientLoadConnectionsAsync              ,


-- ** loadConnectionsFinish #method:loadConnectionsFinish#

#if defined(ENABLE_OVERLOADING)
    ClientLoadConnectionsFinishMethodInfo   ,
#endif
    clientLoadConnectionsFinish             ,


-- ** networkingGetEnabled #method:networkingGetEnabled#

#if defined(ENABLE_OVERLOADING)
    ClientNetworkingGetEnabledMethodInfo    ,
#endif
    clientNetworkingGetEnabled              ,


-- ** networkingSetEnabled #method:networkingSetEnabled#

#if defined(ENABLE_OVERLOADING)
    ClientNetworkingSetEnabledMethodInfo    ,
#endif
    clientNetworkingSetEnabled              ,


-- ** new #method:new#

    clientNew                               ,


-- ** newAsync #method:newAsync#

    clientNewAsync                          ,


-- ** newFinish #method:newFinish#

    clientNewFinish                         ,


-- ** reload #method:reload#

#if defined(ENABLE_OVERLOADING)
    ClientReloadMethodInfo                  ,
#endif
    clientReload                            ,


-- ** reloadConnections #method:reloadConnections#

#if defined(ENABLE_OVERLOADING)
    ClientReloadConnectionsMethodInfo       ,
#endif
    clientReloadConnections                 ,


-- ** reloadConnectionsAsync #method:reloadConnectionsAsync#

#if defined(ENABLE_OVERLOADING)
    ClientReloadConnectionsAsyncMethodInfo  ,
#endif
    clientReloadConnectionsAsync            ,


-- ** reloadConnectionsFinish #method:reloadConnectionsFinish#

#if defined(ENABLE_OVERLOADING)
    ClientReloadConnectionsFinishMethodInfo ,
#endif
    clientReloadConnectionsFinish           ,


-- ** reloadFinish #method:reloadFinish#

#if defined(ENABLE_OVERLOADING)
    ClientReloadFinishMethodInfo            ,
#endif
    clientReloadFinish                      ,


-- ** saveHostname #method:saveHostname#

#if defined(ENABLE_OVERLOADING)
    ClientSaveHostnameMethodInfo            ,
#endif
    clientSaveHostname                      ,


-- ** saveHostnameAsync #method:saveHostnameAsync#

#if defined(ENABLE_OVERLOADING)
    ClientSaveHostnameAsyncMethodInfo       ,
#endif
    clientSaveHostnameAsync                 ,


-- ** saveHostnameFinish #method:saveHostnameFinish#

#if defined(ENABLE_OVERLOADING)
    ClientSaveHostnameFinishMethodInfo      ,
#endif
    clientSaveHostnameFinish                ,


-- ** setLogging #method:setLogging#

#if defined(ENABLE_OVERLOADING)
    ClientSetLoggingMethodInfo              ,
#endif
    clientSetLogging                        ,


-- ** waitShutdown #method:waitShutdown#

#if defined(ENABLE_OVERLOADING)
    ClientWaitShutdownMethodInfo            ,
#endif
    clientWaitShutdown                      ,


-- ** waitShutdownFinish #method:waitShutdownFinish#

    clientWaitShutdownFinish                ,


-- ** wimaxGetEnabled #method:wimaxGetEnabled#

#if defined(ENABLE_OVERLOADING)
    ClientWimaxGetEnabledMethodInfo         ,
#endif
    clientWimaxGetEnabled                   ,


-- ** wimaxHardwareGetEnabled #method:wimaxHardwareGetEnabled#

#if defined(ENABLE_OVERLOADING)
    ClientWimaxHardwareGetEnabledMethodInfo ,
#endif
    clientWimaxHardwareGetEnabled           ,


-- ** wimaxSetEnabled #method:wimaxSetEnabled#

#if defined(ENABLE_OVERLOADING)
    ClientWimaxSetEnabledMethodInfo         ,
#endif
    clientWimaxSetEnabled                   ,


-- ** wirelessGetEnabled #method:wirelessGetEnabled#

#if defined(ENABLE_OVERLOADING)
    ClientWirelessGetEnabledMethodInfo      ,
#endif
    clientWirelessGetEnabled                ,


-- ** wirelessHardwareGetEnabled #method:wirelessHardwareGetEnabled#

#if defined(ENABLE_OVERLOADING)
    ClientWirelessHardwareGetEnabledMethodInfo,
#endif
    clientWirelessHardwareGetEnabled        ,


-- ** wirelessSetEnabled #method:wirelessSetEnabled#

#if defined(ENABLE_OVERLOADING)
    ClientWirelessSetEnabledMethodInfo      ,
#endif
    clientWirelessSetEnabled                ,


-- ** wwanGetEnabled #method:wwanGetEnabled#

#if defined(ENABLE_OVERLOADING)
    ClientWwanGetEnabledMethodInfo          ,
#endif
    clientWwanGetEnabled                    ,


-- ** wwanHardwareGetEnabled #method:wwanHardwareGetEnabled#

#if defined(ENABLE_OVERLOADING)
    ClientWwanHardwareGetEnabledMethodInfo  ,
#endif
    clientWwanHardwareGetEnabled            ,


-- ** wwanSetEnabled #method:wwanSetEnabled#

#if defined(ENABLE_OVERLOADING)
    ClientWwanSetEnabledMethodInfo          ,
#endif
    clientWwanSetEnabled                    ,




 -- * Properties


-- ** activatingConnection #attr:activatingConnection#
-- | The t'GI.NM.Objects.ActiveConnection.ActiveConnection' of the activating connection that is
-- likely to become the new [Client:primaryConnection]("GI.NM.Objects.Client#g:attr:primaryConnection").

#if defined(ENABLE_OVERLOADING)
    ClientActivatingConnectionPropertyInfo  ,
#endif
#if defined(ENABLE_OVERLOADING)
    clientActivatingConnection              ,
#endif
    getClientActivatingConnection           ,


-- ** activeConnections #attr:activeConnections#

#if defined(ENABLE_OVERLOADING)
    ClientActiveConnectionsPropertyInfo     ,
#endif
#if defined(ENABLE_OVERLOADING)
    clientActiveConnections                 ,
#endif


-- ** allDevices #attr:allDevices#

#if defined(ENABLE_OVERLOADING)
    ClientAllDevicesPropertyInfo            ,
#endif
#if defined(ENABLE_OVERLOADING)
    clientAllDevices                        ,
#endif


-- ** canModify #attr:canModify#
-- | If 'P.True', adding and modifying connections is supported.

#if defined(ENABLE_OVERLOADING)
    ClientCanModifyPropertyInfo             ,
#endif
#if defined(ENABLE_OVERLOADING)
    clientCanModify                         ,
#endif
    getClientCanModify                      ,


-- ** capabilities #attr:capabilities#

#if defined(ENABLE_OVERLOADING)
    ClientCapabilitiesPropertyInfo          ,
#endif
#if defined(ENABLE_OVERLOADING)
    clientCapabilities                      ,
#endif


-- ** checkpoints #attr:checkpoints#

#if defined(ENABLE_OVERLOADING)
    ClientCheckpointsPropertyInfo           ,
#endif
#if defined(ENABLE_OVERLOADING)
    clientCheckpoints                       ,
#endif


-- ** connections #attr:connections#

#if defined(ENABLE_OVERLOADING)
    ClientConnectionsPropertyInfo           ,
#endif
#if defined(ENABLE_OVERLOADING)
    clientConnections                       ,
#endif


-- ** connectivity #attr:connectivity#
-- | The network connectivity state.

#if defined(ENABLE_OVERLOADING)
    ClientConnectivityPropertyInfo          ,
#endif
#if defined(ENABLE_OVERLOADING)
    clientConnectivity                      ,
#endif
    getClientConnectivity                   ,


-- ** connectivityCheckAvailable #attr:connectivityCheckAvailable#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    ClientConnectivityCheckAvailablePropertyInfo,
#endif
#if defined(ENABLE_OVERLOADING)
    clientConnectivityCheckAvailable        ,
#endif
    getClientConnectivityCheckAvailable     ,


-- ** connectivityCheckEnabled #attr:connectivityCheckEnabled#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    ClientConnectivityCheckEnabledPropertyInfo,
#endif
#if defined(ENABLE_OVERLOADING)
    clientConnectivityCheckEnabled          ,
#endif
    constructClientConnectivityCheckEnabled ,
    getClientConnectivityCheckEnabled       ,
    setClientConnectivityCheckEnabled       ,


-- ** connectivityCheckUri #attr:connectivityCheckUri#
-- | The used URI for connectivity checking.
-- 
-- /Since: 1.22/

#if defined(ENABLE_OVERLOADING)
    ClientConnectivityCheckUriPropertyInfo  ,
#endif
#if defined(ENABLE_OVERLOADING)
    clientConnectivityCheckUri              ,
#endif
    getClientConnectivityCheckUri           ,


-- ** dbusConnection #attr:dbusConnection#
-- | The t'GI.Gio.Objects.DBusConnection.DBusConnection' to use.
-- 
-- If this is not set during object construction, the D-Bus connection will
-- automatically be chosen during async\/sync initalization via 'GI.Gio.Functions.busGet'.
-- 
-- /Since: 1.22/

#if defined(ENABLE_OVERLOADING)
    ClientDbusConnectionPropertyInfo        ,
#endif
#if defined(ENABLE_OVERLOADING)
    clientDbusConnection                    ,
#endif
    constructClientDbusConnection           ,
    getClientDbusConnection                 ,


-- ** dbusNameOwner #attr:dbusNameOwner#
-- | The name owner of the NetworkManager D-Bus service.
-- 
-- /Since: 1.22/

#if defined(ENABLE_OVERLOADING)
    ClientDbusNameOwnerPropertyInfo         ,
#endif
#if defined(ENABLE_OVERLOADING)
    clientDbusNameOwner                     ,
#endif
    getClientDbusNameOwner                  ,


-- ** devices #attr:devices#

#if defined(ENABLE_OVERLOADING)
    ClientDevicesPropertyInfo               ,
#endif
#if defined(ENABLE_OVERLOADING)
    clientDevices                           ,
#endif


-- ** dnsConfiguration #attr:dnsConfiguration#

#if defined(ENABLE_OVERLOADING)
    ClientDnsConfigurationPropertyInfo      ,
#endif
#if defined(ENABLE_OVERLOADING)
    clientDnsConfiguration                  ,
#endif


-- ** dnsMode #attr:dnsMode#
-- | The current DNS processing mode.
-- 
-- /Since: 1.6/

#if defined(ENABLE_OVERLOADING)
    ClientDnsModePropertyInfo               ,
#endif
#if defined(ENABLE_OVERLOADING)
    clientDnsMode                           ,
#endif
    getClientDnsMode                        ,


-- ** dnsRcManager #attr:dnsRcManager#
-- | The current resolv.conf management mode.
-- 
-- /Since: 1.6/

#if defined(ENABLE_OVERLOADING)
    ClientDnsRcManagerPropertyInfo          ,
#endif
#if defined(ENABLE_OVERLOADING)
    clientDnsRcManager                      ,
#endif
    getClientDnsRcManager                   ,


-- ** hostname #attr:hostname#
-- | The machine hostname stored in persistent configuration. This can be
-- modified by calling 'GI.NM.Objects.Client.clientSaveHostname'.

#if defined(ENABLE_OVERLOADING)
    ClientHostnamePropertyInfo              ,
#endif
#if defined(ENABLE_OVERLOADING)
    clientHostname                          ,
#endif
    getClientHostname                       ,


-- ** instanceFlags #attr:instanceFlags#
-- | t'GI.NM.Flags.ClientInstanceFlags' for the instance. These affect behavior of t'GI.NM.Objects.Client.Client'.
-- This is a construct property and you may only set most flags only during
-- construction.
-- 
-- The flag 'GI.NM.Flags.ClientInstanceFlagsNoAutoFetchPermissions' can be toggled any time,
-- even after constructing the instance. Note that you may want to watch NMClient:permissions-state
-- property to know whether permissions are ready. Note that permissions are only fetched
-- when NMClient has a D-Bus name owner.
-- 
-- The flags 'GI.NM.Flags.ClientInstanceFlagsInitializedGood' and 'GI.NM.Flags.ClientInstanceFlagsInitializedBad'
-- cannot be set, however they will be returned by the getter after initialization completes.
-- 
-- /Since: 1.24/

#if defined(ENABLE_OVERLOADING)
    ClientInstanceFlagsPropertyInfo         ,
#endif
#if defined(ENABLE_OVERLOADING)
    clientInstanceFlags                     ,
#endif
    constructClientInstanceFlags            ,
    getClientInstanceFlags                  ,
    setClientInstanceFlags                  ,


-- ** metered #attr:metered#
-- | Whether the connectivity is metered.
-- 
-- /Since: 1.2/

#if defined(ENABLE_OVERLOADING)
    ClientMeteredPropertyInfo               ,
#endif
#if defined(ENABLE_OVERLOADING)
    clientMetered                           ,
#endif
    getClientMetered                        ,


-- ** networkingEnabled #attr:networkingEnabled#
-- | Whether networking is enabled.
-- 
-- The property setter is a synchronous D-Bus call. This is deprecated since 1.22.

#if defined(ENABLE_OVERLOADING)
    ClientNetworkingEnabledPropertyInfo     ,
#endif
#if defined(ENABLE_OVERLOADING)
    clientNetworkingEnabled                 ,
#endif
    constructClientNetworkingEnabled        ,
    getClientNetworkingEnabled              ,
    setClientNetworkingEnabled              ,


-- ** nmRunning #attr:nmRunning#
-- | Whether the daemon is running.

#if defined(ENABLE_OVERLOADING)
    ClientNmRunningPropertyInfo             ,
#endif
#if defined(ENABLE_OVERLOADING)
    clientNmRunning                         ,
#endif
    getClientNmRunning                      ,


-- ** permissionsState #attr:permissionsState#
-- | The state of the cached permissions. The value 'GI.NM.Enums.TernaryDefault'
-- means that no permissions are yet received (or not yet requested).
-- 'GI.NM.Enums.TernaryTrue' means that permissions are received, cached and up
-- to date. 'GI.NM.Enums.TernaryFalse' means that permissions were received and are
-- cached, but in the meantime a \"CheckPermissions\" signal was received
-- that invalidated the cached permissions.
-- Note that NMClient will always emit a notify[permissionsState](#g:signal:permissionsState) signal
-- when a \"CheckPermissions\" signal got received or after new permissions
-- got received (that is regardless whether the value of the permission state
-- actually changed). With this you can watch the permissions-state property
-- to know whether the permissions are ready. Note that while NMClient has
-- no D-Bus name owner, no permissions are fetched (and this property won\'t
-- change).
-- 
-- /Since: 1.24/

#if defined(ENABLE_OVERLOADING)
    ClientPermissionsStatePropertyInfo      ,
#endif
#if defined(ENABLE_OVERLOADING)
    clientPermissionsState                  ,
#endif
    getClientPermissionsState               ,


-- ** primaryConnection #attr:primaryConnection#
-- | The t'GI.NM.Objects.ActiveConnection.ActiveConnection' of the device with the default route;
-- see 'GI.NM.Objects.Client.clientGetPrimaryConnection' for more details.

#if defined(ENABLE_OVERLOADING)
    ClientPrimaryConnectionPropertyInfo     ,
#endif
#if defined(ENABLE_OVERLOADING)
    clientPrimaryConnection                 ,
#endif
    getClientPrimaryConnection              ,


-- ** radioFlags #attr:radioFlags#
-- | Flags for radio interfaces. See t'GI.NM.Flags.RadioFlags'.
-- 
-- /Since: 1.38/

#if defined(ENABLE_OVERLOADING)
    ClientRadioFlagsPropertyInfo            ,
#endif
#if defined(ENABLE_OVERLOADING)
    clientRadioFlags                        ,
#endif
    getClientRadioFlags                     ,


-- ** startup #attr:startup#
-- | Whether the daemon is still starting up.

#if defined(ENABLE_OVERLOADING)
    ClientStartupPropertyInfo               ,
#endif
#if defined(ENABLE_OVERLOADING)
    clientStartup                           ,
#endif
    getClientStartup                        ,


-- ** state #attr:state#
-- | The current daemon state.

#if defined(ENABLE_OVERLOADING)
    ClientStatePropertyInfo                 ,
#endif
#if defined(ENABLE_OVERLOADING)
    clientState                             ,
#endif
    getClientState                          ,


-- ** version #attr:version#
-- | The NetworkManager version.

#if defined(ENABLE_OVERLOADING)
    ClientVersionPropertyInfo               ,
#endif
#if defined(ENABLE_OVERLOADING)
    clientVersion                           ,
#endif
    getClientVersion                        ,


-- ** versionInfo #attr:versionInfo#

#if defined(ENABLE_OVERLOADING)
    ClientVersionInfoPropertyInfo           ,
#endif
#if defined(ENABLE_OVERLOADING)
    clientVersionInfo                       ,
#endif


-- ** wimaxEnabled #attr:wimaxEnabled#
-- | Whether WiMAX functionality is enabled.

#if defined(ENABLE_OVERLOADING)
    ClientWimaxEnabledPropertyInfo          ,
#endif
#if defined(ENABLE_OVERLOADING)
    clientWimaxEnabled                      ,
#endif
    constructClientWimaxEnabled             ,
    getClientWimaxEnabled                   ,
    setClientWimaxEnabled                   ,


-- ** wimaxHardwareEnabled #attr:wimaxHardwareEnabled#
-- | Whether the WiMAX hardware is enabled.

#if defined(ENABLE_OVERLOADING)
    ClientWimaxHardwareEnabledPropertyInfo  ,
#endif
#if defined(ENABLE_OVERLOADING)
    clientWimaxHardwareEnabled              ,
#endif
    getClientWimaxHardwareEnabled           ,


-- ** wirelessEnabled #attr:wirelessEnabled#
-- | Whether wireless is enabled.
-- 
-- The property setter is a synchronous D-Bus call. This is deprecated since 1.22.

#if defined(ENABLE_OVERLOADING)
    ClientWirelessEnabledPropertyInfo       ,
#endif
#if defined(ENABLE_OVERLOADING)
    clientWirelessEnabled                   ,
#endif
    constructClientWirelessEnabled          ,
    getClientWirelessEnabled                ,
    setClientWirelessEnabled                ,


-- ** wirelessHardwareEnabled #attr:wirelessHardwareEnabled#
-- | Whether the wireless hardware is enabled.

#if defined(ENABLE_OVERLOADING)
    ClientWirelessHardwareEnabledPropertyInfo,
#endif
#if defined(ENABLE_OVERLOADING)
    clientWirelessHardwareEnabled           ,
#endif
    getClientWirelessHardwareEnabled        ,


-- ** wwanEnabled #attr:wwanEnabled#
-- | Whether WWAN functionality is enabled.
-- 
-- The property setter is a synchronous D-Bus call. This is deprecated since 1.22.

#if defined(ENABLE_OVERLOADING)
    ClientWwanEnabledPropertyInfo           ,
#endif
#if defined(ENABLE_OVERLOADING)
    clientWwanEnabled                       ,
#endif
    constructClientWwanEnabled              ,
    getClientWwanEnabled                    ,
    setClientWwanEnabled                    ,


-- ** wwanHardwareEnabled #attr:wwanHardwareEnabled#
-- | Whether the WWAN hardware is enabled.

#if defined(ENABLE_OVERLOADING)
    ClientWwanHardwareEnabledPropertyInfo   ,
#endif
#if defined(ENABLE_OVERLOADING)
    clientWwanHardwareEnabled               ,
#endif
    getClientWwanHardwareEnabled            ,




 -- * Signals


-- ** activeConnectionAdded #signal:activeConnectionAdded#

    ClientActiveConnectionAddedCallback     ,
#if defined(ENABLE_OVERLOADING)
    ClientActiveConnectionAddedSignalInfo   ,
#endif
    afterClientActiveConnectionAdded        ,
    onClientActiveConnectionAdded           ,


-- ** activeConnectionRemoved #signal:activeConnectionRemoved#

    ClientActiveConnectionRemovedCallback   ,
#if defined(ENABLE_OVERLOADING)
    ClientActiveConnectionRemovedSignalInfo ,
#endif
    afterClientActiveConnectionRemoved      ,
    onClientActiveConnectionRemoved         ,


-- ** anyDeviceAdded #signal:anyDeviceAdded#

    ClientAnyDeviceAddedCallback            ,
#if defined(ENABLE_OVERLOADING)
    ClientAnyDeviceAddedSignalInfo          ,
#endif
    afterClientAnyDeviceAdded               ,
    onClientAnyDeviceAdded                  ,


-- ** anyDeviceRemoved #signal:anyDeviceRemoved#

    ClientAnyDeviceRemovedCallback          ,
#if defined(ENABLE_OVERLOADING)
    ClientAnyDeviceRemovedSignalInfo        ,
#endif
    afterClientAnyDeviceRemoved             ,
    onClientAnyDeviceRemoved                ,


-- ** connectionAdded #signal:connectionAdded#

    ClientConnectionAddedCallback           ,
#if defined(ENABLE_OVERLOADING)
    ClientConnectionAddedSignalInfo         ,
#endif
    afterClientConnectionAdded              ,
    onClientConnectionAdded                 ,


-- ** connectionRemoved #signal:connectionRemoved#

    ClientConnectionRemovedCallback         ,
#if defined(ENABLE_OVERLOADING)
    ClientConnectionRemovedSignalInfo       ,
#endif
    afterClientConnectionRemoved            ,
    onClientConnectionRemoved               ,


-- ** deviceAdded #signal:deviceAdded#

    ClientDeviceAddedCallback               ,
#if defined(ENABLE_OVERLOADING)
    ClientDeviceAddedSignalInfo             ,
#endif
    afterClientDeviceAdded                  ,
    onClientDeviceAdded                     ,


-- ** deviceRemoved #signal:deviceRemoved#

    ClientDeviceRemovedCallback             ,
#if defined(ENABLE_OVERLOADING)
    ClientDeviceRemovedSignalInfo           ,
#endif
    afterClientDeviceRemoved                ,
    onClientDeviceRemoved                   ,


-- ** permissionChanged #signal:permissionChanged#

    ClientPermissionChangedCallback         ,
#if defined(ENABLE_OVERLOADING)
    ClientPermissionChangedSignalInfo       ,
#endif
    afterClientPermissionChanged            ,
    onClientPermissionChanged               ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R
import qualified Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.GLib.Structs.Bytes as GLib.Bytes
import qualified GI.GLib.Structs.MainContext as GLib.MainContext
import qualified GI.GLib.Structs.VariantType as GLib.VariantType
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Callbacks as Gio.Callbacks
import qualified GI.Gio.Interfaces.AsyncInitable as Gio.AsyncInitable
import qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import qualified GI.Gio.Interfaces.Initable as Gio.Initable
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import qualified GI.Gio.Objects.DBusConnection as Gio.DBusConnection
import qualified GI.NM.Callbacks as NM.Callbacks
import {-# SOURCE #-} qualified GI.NM.Enums as NM.Enums
import {-# SOURCE #-} qualified GI.NM.Flags as NM.Flags
import {-# SOURCE #-} qualified GI.NM.Interfaces.Connection as NM.Connection
import {-# SOURCE #-} qualified GI.NM.Objects.ActiveConnection as NM.ActiveConnection
import {-# SOURCE #-} qualified GI.NM.Objects.Checkpoint as NM.Checkpoint
import {-# SOURCE #-} qualified GI.NM.Objects.Device as NM.Device
import {-# SOURCE #-} qualified GI.NM.Objects.DhcpConfig as NM.DhcpConfig
import {-# SOURCE #-} qualified GI.NM.Objects.IPConfig as NM.IPConfig
import {-# SOURCE #-} qualified GI.NM.Objects.Object as NM.Object
import {-# SOURCE #-} qualified GI.NM.Objects.RemoteConnection as NM.RemoteConnection
import {-# SOURCE #-} qualified GI.NM.Objects.Setting as NM.Setting
import {-# SOURCE #-} qualified GI.NM.Objects.Setting8021x as NM.Setting8021x
import {-# SOURCE #-} qualified GI.NM.Objects.SettingAdsl as NM.SettingAdsl
import {-# SOURCE #-} qualified GI.NM.Objects.SettingBluetooth as NM.SettingBluetooth
import {-# SOURCE #-} qualified GI.NM.Objects.SettingBond as NM.SettingBond
import {-# SOURCE #-} qualified GI.NM.Objects.SettingBridge as NM.SettingBridge
import {-# SOURCE #-} qualified GI.NM.Objects.SettingBridgePort as NM.SettingBridgePort
import {-# SOURCE #-} qualified GI.NM.Objects.SettingCdma as NM.SettingCdma
import {-# SOURCE #-} qualified GI.NM.Objects.SettingConnection as NM.SettingConnection
import {-# SOURCE #-} qualified GI.NM.Objects.SettingDcb as NM.SettingDcb
import {-# SOURCE #-} qualified GI.NM.Objects.SettingDummy as NM.SettingDummy
import {-# SOURCE #-} qualified GI.NM.Objects.SettingGeneric as NM.SettingGeneric
import {-# SOURCE #-} qualified GI.NM.Objects.SettingGsm as NM.SettingGsm
import {-# SOURCE #-} qualified GI.NM.Objects.SettingIP4Config as NM.SettingIP4Config
import {-# SOURCE #-} qualified GI.NM.Objects.SettingIP6Config as NM.SettingIP6Config
import {-# SOURCE #-} qualified GI.NM.Objects.SettingIPConfig as NM.SettingIPConfig
import {-# SOURCE #-} qualified GI.NM.Objects.SettingIPTunnel as NM.SettingIPTunnel
import {-# SOURCE #-} qualified GI.NM.Objects.SettingInfiniband as NM.SettingInfiniband
import {-# SOURCE #-} qualified GI.NM.Objects.SettingMacsec as NM.SettingMacsec
import {-# SOURCE #-} qualified GI.NM.Objects.SettingMacvlan as NM.SettingMacvlan
import {-# SOURCE #-} qualified GI.NM.Objects.SettingOlpcMesh as NM.SettingOlpcMesh
import {-# SOURCE #-} qualified GI.NM.Objects.SettingOvsBridge as NM.SettingOvsBridge
import {-# SOURCE #-} qualified GI.NM.Objects.SettingOvsInterface as NM.SettingOvsInterface
import {-# SOURCE #-} qualified GI.NM.Objects.SettingOvsPatch as NM.SettingOvsPatch
import {-# SOURCE #-} qualified GI.NM.Objects.SettingOvsPort as NM.SettingOvsPort
import {-# SOURCE #-} qualified GI.NM.Objects.SettingPpp as NM.SettingPpp
import {-# SOURCE #-} qualified GI.NM.Objects.SettingPppoe as NM.SettingPppoe
import {-# SOURCE #-} qualified GI.NM.Objects.SettingProxy as NM.SettingProxy
import {-# SOURCE #-} qualified GI.NM.Objects.SettingSerial as NM.SettingSerial
import {-# SOURCE #-} qualified GI.NM.Objects.SettingTCConfig as NM.SettingTCConfig
import {-# SOURCE #-} qualified GI.NM.Objects.SettingTeam as NM.SettingTeam
import {-# SOURCE #-} qualified GI.NM.Objects.SettingTeamPort as NM.SettingTeamPort
import {-# SOURCE #-} qualified GI.NM.Objects.SettingTun as NM.SettingTun
import {-# SOURCE #-} qualified GI.NM.Objects.SettingVlan as NM.SettingVlan
import {-# SOURCE #-} qualified GI.NM.Objects.SettingVpn as NM.SettingVpn
import {-# SOURCE #-} qualified GI.NM.Objects.SettingVxlan as NM.SettingVxlan
import {-# SOURCE #-} qualified GI.NM.Objects.SettingWimax as NM.SettingWimax
import {-# SOURCE #-} qualified GI.NM.Objects.SettingWired as NM.SettingWired
import {-# SOURCE #-} qualified GI.NM.Objects.SettingWireless as NM.SettingWireless
import {-# SOURCE #-} qualified GI.NM.Objects.SettingWirelessSecurity as NM.SettingWirelessSecurity
import {-# SOURCE #-} qualified GI.NM.Structs.BridgeVlan as NM.BridgeVlan
import {-# SOURCE #-} qualified GI.NM.Structs.DnsEntry as NM.DnsEntry
import {-# SOURCE #-} qualified GI.NM.Structs.IPAddress as NM.IPAddress
import {-# SOURCE #-} qualified GI.NM.Structs.IPRoute as NM.IPRoute
import {-# SOURCE #-} qualified GI.NM.Structs.IPRoutingRule as NM.IPRoutingRule
import {-# SOURCE #-} qualified GI.NM.Structs.LldpNeighbor as NM.LldpNeighbor
import {-# SOURCE #-} qualified GI.NM.Structs.Range as NM.Range
import {-# SOURCE #-} qualified GI.NM.Structs.TCAction as NM.TCAction
import {-# SOURCE #-} qualified GI.NM.Structs.TCQdisc as NM.TCQdisc
import {-# SOURCE #-} qualified GI.NM.Structs.TCTfilter as NM.TCTfilter
import {-# SOURCE #-} qualified GI.NM.Structs.TeamLinkWatcher as NM.TeamLinkWatcher
import {-# SOURCE #-} qualified GI.NM.Structs.VariantAttributeSpec as NM.VariantAttributeSpec

#else
import qualified GI.GLib.Structs.MainContext as GLib.MainContext
import qualified GI.GLib.Structs.VariantType as GLib.VariantType
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Callbacks as Gio.Callbacks
import qualified GI.Gio.Interfaces.AsyncInitable as Gio.AsyncInitable
import qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import qualified GI.Gio.Interfaces.Initable as Gio.Initable
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import qualified GI.Gio.Objects.DBusConnection as Gio.DBusConnection
import {-# SOURCE #-} qualified GI.NM.Enums as NM.Enums
import {-# SOURCE #-} qualified GI.NM.Flags as NM.Flags
import {-# SOURCE #-} qualified GI.NM.Interfaces.Connection as NM.Connection
import {-# SOURCE #-} qualified GI.NM.Objects.ActiveConnection as NM.ActiveConnection
import {-# SOURCE #-} qualified GI.NM.Objects.Checkpoint as NM.Checkpoint
import {-# SOURCE #-} qualified GI.NM.Objects.Device as NM.Device
import {-# SOURCE #-} qualified GI.NM.Objects.Object as NM.Object
import {-# SOURCE #-} qualified GI.NM.Objects.RemoteConnection as NM.RemoteConnection
import {-# SOURCE #-} qualified GI.NM.Structs.DnsEntry as NM.DnsEntry

#endif

-- | Memory-managed wrapper type.
newtype Client = Client (SP.ManagedPtr Client)
    deriving (Client -> Client -> Bool
(Client -> Client -> Bool)
-> (Client -> Client -> Bool) -> Eq Client
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Client -> Client -> Bool
== :: Client -> Client -> Bool
$c/= :: Client -> Client -> Bool
/= :: Client -> Client -> Bool
Eq)

instance SP.ManagedPtrNewtype Client where
    toManagedPtr :: Client -> ManagedPtr Client
toManagedPtr (Client ManagedPtr Client
p) = ManagedPtr Client
p

foreign import ccall "nm_client_get_type"
    c_nm_client_get_type :: IO B.Types.GType

instance B.Types.TypedObject Client where
    glibType :: IO GType
glibType = IO GType
c_nm_client_get_type

instance B.Types.GObject Client

-- | Type class for types which can be safely cast to t'Client', for instance with `toClient`.
class (SP.GObject o, O.IsDescendantOf Client o) => IsClient o
instance (SP.GObject o, O.IsDescendantOf Client o) => IsClient o

instance O.HasParentTypes Client
type instance O.ParentTypes Client = '[GObject.Object.Object, Gio.AsyncInitable.AsyncInitable, Gio.Initable.Initable]

-- | Cast to t'Client', for types for which this is known to be safe. For general casts, use 'Data.GI.Base.ManagedPtr.castTo'.
toClient :: (MIO.MonadIO m, IsClient o) => o -> m Client
toClient :: forall (m :: * -> *) o. (MonadIO m, IsClient o) => o -> m Client
toClient = IO Client -> m Client
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Client -> m Client) -> (o -> IO Client) -> o -> m Client
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr Client -> Client) -> o -> IO Client
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr Client -> Client
Client

-- | Convert t'Client' to and from t'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe Client) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_nm_client_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Client -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Client
P.Nothing = Ptr GValue -> Ptr Client -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr Client
forall a. Ptr a
FP.nullPtr :: FP.Ptr Client)
    gvalueSet_ Ptr GValue
gv (P.Just Client
obj) = Client -> (Ptr Client -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Client
obj (Ptr GValue -> Ptr Client -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Client)
gvalueGet_ Ptr GValue
gv = do
        Ptr Client
ptr <- Ptr GValue -> IO (Ptr Client)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr Client)
        if Ptr Client
ptr Ptr Client -> Ptr Client -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Client
forall a. Ptr a
FP.nullPtr
        then Client -> Maybe Client
forall a. a -> Maybe a
P.Just (Client -> Maybe Client) -> IO Client -> IO (Maybe Client)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Client -> Client) -> Ptr Client -> IO Client
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Client -> Client
Client Ptr Client
ptr
        else Maybe Client -> IO (Maybe Client)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Client
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveClientMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveClientMethod "activateConnectionAsync" o = ClientActivateConnectionAsyncMethodInfo
    ResolveClientMethod "activateConnectionFinish" o = ClientActivateConnectionFinishMethodInfo
    ResolveClientMethod "addAndActivateConnection2" o = ClientAddAndActivateConnection2MethodInfo
    ResolveClientMethod "addAndActivateConnection2Finish" o = ClientAddAndActivateConnection2FinishMethodInfo
    ResolveClientMethod "addAndActivateConnectionAsync" o = ClientAddAndActivateConnectionAsyncMethodInfo
    ResolveClientMethod "addAndActivateConnectionFinish" o = ClientAddAndActivateConnectionFinishMethodInfo
    ResolveClientMethod "addConnection2" o = ClientAddConnection2MethodInfo
    ResolveClientMethod "addConnection2Finish" o = ClientAddConnection2FinishMethodInfo
    ResolveClientMethod "addConnectionAsync" o = ClientAddConnectionAsyncMethodInfo
    ResolveClientMethod "addConnectionFinish" o = ClientAddConnectionFinishMethodInfo
    ResolveClientMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveClientMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveClientMethod "checkConnectivity" o = ClientCheckConnectivityMethodInfo
    ResolveClientMethod "checkConnectivityAsync" o = ClientCheckConnectivityAsyncMethodInfo
    ResolveClientMethod "checkConnectivityFinish" o = ClientCheckConnectivityFinishMethodInfo
    ResolveClientMethod "checkpointAdjustRollbackTimeout" o = ClientCheckpointAdjustRollbackTimeoutMethodInfo
    ResolveClientMethod "checkpointAdjustRollbackTimeoutFinish" o = ClientCheckpointAdjustRollbackTimeoutFinishMethodInfo
    ResolveClientMethod "checkpointCreate" o = ClientCheckpointCreateMethodInfo
    ResolveClientMethod "checkpointCreateFinish" o = ClientCheckpointCreateFinishMethodInfo
    ResolveClientMethod "checkpointDestroy" o = ClientCheckpointDestroyMethodInfo
    ResolveClientMethod "checkpointDestroyFinish" o = ClientCheckpointDestroyFinishMethodInfo
    ResolveClientMethod "checkpointRollback" o = ClientCheckpointRollbackMethodInfo
    ResolveClientMethod "checkpointRollbackFinish" o = ClientCheckpointRollbackFinishMethodInfo
    ResolveClientMethod "connectivityCheckGetAvailable" o = ClientConnectivityCheckGetAvailableMethodInfo
    ResolveClientMethod "connectivityCheckGetEnabled" o = ClientConnectivityCheckGetEnabledMethodInfo
    ResolveClientMethod "connectivityCheckGetUri" o = ClientConnectivityCheckGetUriMethodInfo
    ResolveClientMethod "connectivityCheckSetEnabled" o = ClientConnectivityCheckSetEnabledMethodInfo
    ResolveClientMethod "dbusCall" o = ClientDbusCallMethodInfo
    ResolveClientMethod "dbusCallFinish" o = ClientDbusCallFinishMethodInfo
    ResolveClientMethod "dbusSetProperty" o = ClientDbusSetPropertyMethodInfo
    ResolveClientMethod "dbusSetPropertyFinish" o = ClientDbusSetPropertyFinishMethodInfo
    ResolveClientMethod "deactivateConnection" o = ClientDeactivateConnectionMethodInfo
    ResolveClientMethod "deactivateConnectionAsync" o = ClientDeactivateConnectionAsyncMethodInfo
    ResolveClientMethod "deactivateConnectionFinish" o = ClientDeactivateConnectionFinishMethodInfo
    ResolveClientMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveClientMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveClientMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveClientMethod "init" o = Gio.Initable.InitableInitMethodInfo
    ResolveClientMethod "initAsync" o = Gio.AsyncInitable.AsyncInitableInitAsyncMethodInfo
    ResolveClientMethod "initFinish" o = Gio.AsyncInitable.AsyncInitableInitFinishMethodInfo
    ResolveClientMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveClientMethod "loadConnections" o = ClientLoadConnectionsMethodInfo
    ResolveClientMethod "loadConnectionsAsync" o = ClientLoadConnectionsAsyncMethodInfo
    ResolveClientMethod "loadConnectionsFinish" o = ClientLoadConnectionsFinishMethodInfo
    ResolveClientMethod "networkingGetEnabled" o = ClientNetworkingGetEnabledMethodInfo
    ResolveClientMethod "networkingSetEnabled" o = ClientNetworkingSetEnabledMethodInfo
    ResolveClientMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveClientMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveClientMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveClientMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveClientMethod "reload" o = ClientReloadMethodInfo
    ResolveClientMethod "reloadConnections" o = ClientReloadConnectionsMethodInfo
    ResolveClientMethod "reloadConnectionsAsync" o = ClientReloadConnectionsAsyncMethodInfo
    ResolveClientMethod "reloadConnectionsFinish" o = ClientReloadConnectionsFinishMethodInfo
    ResolveClientMethod "reloadFinish" o = ClientReloadFinishMethodInfo
    ResolveClientMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveClientMethod "saveHostname" o = ClientSaveHostnameMethodInfo
    ResolveClientMethod "saveHostnameAsync" o = ClientSaveHostnameAsyncMethodInfo
    ResolveClientMethod "saveHostnameFinish" o = ClientSaveHostnameFinishMethodInfo
    ResolveClientMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveClientMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveClientMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveClientMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveClientMethod "waitShutdown" o = ClientWaitShutdownMethodInfo
    ResolveClientMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveClientMethod "wimaxGetEnabled" o = ClientWimaxGetEnabledMethodInfo
    ResolveClientMethod "wimaxHardwareGetEnabled" o = ClientWimaxHardwareGetEnabledMethodInfo
    ResolveClientMethod "wimaxSetEnabled" o = ClientWimaxSetEnabledMethodInfo
    ResolveClientMethod "wirelessGetEnabled" o = ClientWirelessGetEnabledMethodInfo
    ResolveClientMethod "wirelessHardwareGetEnabled" o = ClientWirelessHardwareGetEnabledMethodInfo
    ResolveClientMethod "wirelessSetEnabled" o = ClientWirelessSetEnabledMethodInfo
    ResolveClientMethod "wwanGetEnabled" o = ClientWwanGetEnabledMethodInfo
    ResolveClientMethod "wwanHardwareGetEnabled" o = ClientWwanHardwareGetEnabledMethodInfo
    ResolveClientMethod "wwanSetEnabled" o = ClientWwanSetEnabledMethodInfo
    ResolveClientMethod "getActivatingConnection" o = ClientGetActivatingConnectionMethodInfo
    ResolveClientMethod "getActiveConnections" o = ClientGetActiveConnectionsMethodInfo
    ResolveClientMethod "getAllDevices" o = ClientGetAllDevicesMethodInfo
    ResolveClientMethod "getCapabilities" o = ClientGetCapabilitiesMethodInfo
    ResolveClientMethod "getCheckpoints" o = ClientGetCheckpointsMethodInfo
    ResolveClientMethod "getConnectionById" o = ClientGetConnectionByIdMethodInfo
    ResolveClientMethod "getConnectionByPath" o = ClientGetConnectionByPathMethodInfo
    ResolveClientMethod "getConnectionByUuid" o = ClientGetConnectionByUuidMethodInfo
    ResolveClientMethod "getConnections" o = ClientGetConnectionsMethodInfo
    ResolveClientMethod "getConnectivity" o = ClientGetConnectivityMethodInfo
    ResolveClientMethod "getContextBusyWatcher" o = ClientGetContextBusyWatcherMethodInfo
    ResolveClientMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveClientMethod "getDbusConnection" o = ClientGetDbusConnectionMethodInfo
    ResolveClientMethod "getDbusNameOwner" o = ClientGetDbusNameOwnerMethodInfo
    ResolveClientMethod "getDeviceByIface" o = ClientGetDeviceByIfaceMethodInfo
    ResolveClientMethod "getDeviceByPath" o = ClientGetDeviceByPathMethodInfo
    ResolveClientMethod "getDevices" o = ClientGetDevicesMethodInfo
    ResolveClientMethod "getDnsConfiguration" o = ClientGetDnsConfigurationMethodInfo
    ResolveClientMethod "getDnsMode" o = ClientGetDnsModeMethodInfo
    ResolveClientMethod "getDnsRcManager" o = ClientGetDnsRcManagerMethodInfo
    ResolveClientMethod "getInstanceFlags" o = ClientGetInstanceFlagsMethodInfo
    ResolveClientMethod "getLogging" o = ClientGetLoggingMethodInfo
    ResolveClientMethod "getMainContext" o = ClientGetMainContextMethodInfo
    ResolveClientMethod "getMetered" o = ClientGetMeteredMethodInfo
    ResolveClientMethod "getNmRunning" o = ClientGetNmRunningMethodInfo
    ResolveClientMethod "getObjectByPath" o = ClientGetObjectByPathMethodInfo
    ResolveClientMethod "getPermissionResult" o = ClientGetPermissionResultMethodInfo
    ResolveClientMethod "getPermissionsState" o = ClientGetPermissionsStateMethodInfo
    ResolveClientMethod "getPrimaryConnection" o = ClientGetPrimaryConnectionMethodInfo
    ResolveClientMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveClientMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveClientMethod "getRadioFlags" o = ClientGetRadioFlagsMethodInfo
    ResolveClientMethod "getStartup" o = ClientGetStartupMethodInfo
    ResolveClientMethod "getState" o = ClientGetStateMethodInfo
    ResolveClientMethod "getVersion" o = ClientGetVersionMethodInfo
    ResolveClientMethod "getVersionInfo" o = ClientGetVersionInfoMethodInfo
    ResolveClientMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveClientMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveClientMethod "setLogging" o = ClientSetLoggingMethodInfo
    ResolveClientMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveClientMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveClientMethod t Client, O.OverloadedMethod info Client p) => OL.IsLabel t (Client -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveClientMethod t Client, O.OverloadedMethod info Client p, R.HasField t Client p) => R.HasField t Client p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolveClientMethod t Client, O.OverloadedMethodInfo info Client) => OL.IsLabel t (O.MethodProxy info Client) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif

-- signal Client::active-connection-added
-- | Notifies that a t'GI.NM.Objects.ActiveConnection.ActiveConnection' has been added.
type ClientActiveConnectionAddedCallback =
    NM.ActiveConnection.ActiveConnection
    -- ^ /@activeConnection@/: the new active connection
    -> IO ()

type C_ClientActiveConnectionAddedCallback =
    Ptr Client ->                           -- object
    Ptr NM.ActiveConnection.ActiveConnection ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_ClientActiveConnectionAddedCallback`.
foreign import ccall "wrapper"
    mk_ClientActiveConnectionAddedCallback :: C_ClientActiveConnectionAddedCallback -> IO (FunPtr C_ClientActiveConnectionAddedCallback)

wrap_ClientActiveConnectionAddedCallback :: 
    GObject a => (a -> ClientActiveConnectionAddedCallback) ->
    C_ClientActiveConnectionAddedCallback
wrap_ClientActiveConnectionAddedCallback :: forall a.
GObject a =>
(a -> ClientActiveConnectionAddedCallback)
-> C_ClientActiveConnectionAddedCallback
wrap_ClientActiveConnectionAddedCallback a -> ClientActiveConnectionAddedCallback
gi'cb Ptr Client
gi'selfPtr Ptr ActiveConnection
activeConnection Ptr ()
_ = do
    ActiveConnection
activeConnection' <- ((ManagedPtr ActiveConnection -> ActiveConnection)
-> Ptr ActiveConnection -> IO ActiveConnection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ActiveConnection -> ActiveConnection
NM.ActiveConnection.ActiveConnection) Ptr ActiveConnection
activeConnection
    Ptr Client -> (Client -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr Client
gi'selfPtr ((Client -> IO ()) -> IO ()) -> (Client -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Client
gi'self -> a -> ClientActiveConnectionAddedCallback
gi'cb (Client -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Client
gi'self)  ActiveConnection
activeConnection'


-- | Connect a signal handler for the [activeConnectionAdded](#signal:activeConnectionAdded) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' client #activeConnectionAdded callback
-- @
-- 
-- 
onClientActiveConnectionAdded :: (IsClient a, MonadIO m) => a -> ((?self :: a) => ClientActiveConnectionAddedCallback) -> m SignalHandlerId
onClientActiveConnectionAdded :: forall a (m :: * -> *).
(IsClient a, MonadIO m) =>
a
-> ((?self::a) => ClientActiveConnectionAddedCallback)
-> m SignalHandlerId
onClientActiveConnectionAdded a
obj (?self::a) => ClientActiveConnectionAddedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ClientActiveConnectionAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ClientActiveConnectionAddedCallback
ClientActiveConnectionAddedCallback
cb
    let wrapped' :: C_ClientActiveConnectionAddedCallback
wrapped' = (a -> ClientActiveConnectionAddedCallback)
-> C_ClientActiveConnectionAddedCallback
forall a.
GObject a =>
(a -> ClientActiveConnectionAddedCallback)
-> C_ClientActiveConnectionAddedCallback
wrap_ClientActiveConnectionAddedCallback a -> ClientActiveConnectionAddedCallback
wrapped
    FunPtr C_ClientActiveConnectionAddedCallback
wrapped'' <- C_ClientActiveConnectionAddedCallback
-> IO (FunPtr C_ClientActiveConnectionAddedCallback)
mk_ClientActiveConnectionAddedCallback C_ClientActiveConnectionAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_ClientActiveConnectionAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"active-connection-added" FunPtr C_ClientActiveConnectionAddedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [activeConnectionAdded](#signal:activeConnectionAdded) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' client #activeConnectionAdded callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterClientActiveConnectionAdded :: (IsClient a, MonadIO m) => a -> ((?self :: a) => ClientActiveConnectionAddedCallback) -> m SignalHandlerId
afterClientActiveConnectionAdded :: forall a (m :: * -> *).
(IsClient a, MonadIO m) =>
a
-> ((?self::a) => ClientActiveConnectionAddedCallback)
-> m SignalHandlerId
afterClientActiveConnectionAdded a
obj (?self::a) => ClientActiveConnectionAddedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ClientActiveConnectionAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ClientActiveConnectionAddedCallback
ClientActiveConnectionAddedCallback
cb
    let wrapped' :: C_ClientActiveConnectionAddedCallback
wrapped' = (a -> ClientActiveConnectionAddedCallback)
-> C_ClientActiveConnectionAddedCallback
forall a.
GObject a =>
(a -> ClientActiveConnectionAddedCallback)
-> C_ClientActiveConnectionAddedCallback
wrap_ClientActiveConnectionAddedCallback a -> ClientActiveConnectionAddedCallback
wrapped
    FunPtr C_ClientActiveConnectionAddedCallback
wrapped'' <- C_ClientActiveConnectionAddedCallback
-> IO (FunPtr C_ClientActiveConnectionAddedCallback)
mk_ClientActiveConnectionAddedCallback C_ClientActiveConnectionAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_ClientActiveConnectionAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"active-connection-added" FunPtr C_ClientActiveConnectionAddedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ClientActiveConnectionAddedSignalInfo
instance SignalInfo ClientActiveConnectionAddedSignalInfo where
    type HaskellCallbackType ClientActiveConnectionAddedSignalInfo = ClientActiveConnectionAddedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ClientActiveConnectionAddedCallback cb
        cb'' <- mk_ClientActiveConnectionAddedCallback cb'
        connectSignalFunPtr obj "active-connection-added" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client::active-connection-added"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#g:signal:activeConnectionAdded"})

#endif

-- signal Client::active-connection-removed
-- | Notifies that a t'GI.NM.Objects.ActiveConnection.ActiveConnection' has been removed.
type ClientActiveConnectionRemovedCallback =
    NM.ActiveConnection.ActiveConnection
    -- ^ /@activeConnection@/: the removed active connection
    -> IO ()

type C_ClientActiveConnectionRemovedCallback =
    Ptr Client ->                           -- object
    Ptr NM.ActiveConnection.ActiveConnection ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_ClientActiveConnectionRemovedCallback`.
foreign import ccall "wrapper"
    mk_ClientActiveConnectionRemovedCallback :: C_ClientActiveConnectionRemovedCallback -> IO (FunPtr C_ClientActiveConnectionRemovedCallback)

wrap_ClientActiveConnectionRemovedCallback :: 
    GObject a => (a -> ClientActiveConnectionRemovedCallback) ->
    C_ClientActiveConnectionRemovedCallback
wrap_ClientActiveConnectionRemovedCallback :: forall a.
GObject a =>
(a -> ClientActiveConnectionAddedCallback)
-> C_ClientActiveConnectionAddedCallback
wrap_ClientActiveConnectionRemovedCallback a -> ClientActiveConnectionAddedCallback
gi'cb Ptr Client
gi'selfPtr Ptr ActiveConnection
activeConnection Ptr ()
_ = do
    ActiveConnection
activeConnection' <- ((ManagedPtr ActiveConnection -> ActiveConnection)
-> Ptr ActiveConnection -> IO ActiveConnection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ActiveConnection -> ActiveConnection
NM.ActiveConnection.ActiveConnection) Ptr ActiveConnection
activeConnection
    Ptr Client -> (Client -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr Client
gi'selfPtr ((Client -> IO ()) -> IO ()) -> (Client -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Client
gi'self -> a -> ClientActiveConnectionAddedCallback
gi'cb (Client -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Client
gi'self)  ActiveConnection
activeConnection'


-- | Connect a signal handler for the [activeConnectionRemoved](#signal:activeConnectionRemoved) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' client #activeConnectionRemoved callback
-- @
-- 
-- 
onClientActiveConnectionRemoved :: (IsClient a, MonadIO m) => a -> ((?self :: a) => ClientActiveConnectionRemovedCallback) -> m SignalHandlerId
onClientActiveConnectionRemoved :: forall a (m :: * -> *).
(IsClient a, MonadIO m) =>
a
-> ((?self::a) => ClientActiveConnectionAddedCallback)
-> m SignalHandlerId
onClientActiveConnectionRemoved a
obj (?self::a) => ClientActiveConnectionAddedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ClientActiveConnectionAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ClientActiveConnectionAddedCallback
ClientActiveConnectionAddedCallback
cb
    let wrapped' :: C_ClientActiveConnectionAddedCallback
wrapped' = (a -> ClientActiveConnectionAddedCallback)
-> C_ClientActiveConnectionAddedCallback
forall a.
GObject a =>
(a -> ClientActiveConnectionAddedCallback)
-> C_ClientActiveConnectionAddedCallback
wrap_ClientActiveConnectionRemovedCallback a -> ClientActiveConnectionAddedCallback
wrapped
    FunPtr C_ClientActiveConnectionAddedCallback
wrapped'' <- C_ClientActiveConnectionAddedCallback
-> IO (FunPtr C_ClientActiveConnectionAddedCallback)
mk_ClientActiveConnectionRemovedCallback C_ClientActiveConnectionAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_ClientActiveConnectionAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"active-connection-removed" FunPtr C_ClientActiveConnectionAddedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [activeConnectionRemoved](#signal:activeConnectionRemoved) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' client #activeConnectionRemoved callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterClientActiveConnectionRemoved :: (IsClient a, MonadIO m) => a -> ((?self :: a) => ClientActiveConnectionRemovedCallback) -> m SignalHandlerId
afterClientActiveConnectionRemoved :: forall a (m :: * -> *).
(IsClient a, MonadIO m) =>
a
-> ((?self::a) => ClientActiveConnectionAddedCallback)
-> m SignalHandlerId
afterClientActiveConnectionRemoved a
obj (?self::a) => ClientActiveConnectionAddedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ClientActiveConnectionAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ClientActiveConnectionAddedCallback
ClientActiveConnectionAddedCallback
cb
    let wrapped' :: C_ClientActiveConnectionAddedCallback
wrapped' = (a -> ClientActiveConnectionAddedCallback)
-> C_ClientActiveConnectionAddedCallback
forall a.
GObject a =>
(a -> ClientActiveConnectionAddedCallback)
-> C_ClientActiveConnectionAddedCallback
wrap_ClientActiveConnectionRemovedCallback a -> ClientActiveConnectionAddedCallback
wrapped
    FunPtr C_ClientActiveConnectionAddedCallback
wrapped'' <- C_ClientActiveConnectionAddedCallback
-> IO (FunPtr C_ClientActiveConnectionAddedCallback)
mk_ClientActiveConnectionRemovedCallback C_ClientActiveConnectionAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_ClientActiveConnectionAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"active-connection-removed" FunPtr C_ClientActiveConnectionAddedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ClientActiveConnectionRemovedSignalInfo
instance SignalInfo ClientActiveConnectionRemovedSignalInfo where
    type HaskellCallbackType ClientActiveConnectionRemovedSignalInfo = ClientActiveConnectionRemovedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ClientActiveConnectionRemovedCallback cb
        cb'' <- mk_ClientActiveConnectionRemovedCallback cb'
        connectSignalFunPtr obj "active-connection-removed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client::active-connection-removed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#g:signal:activeConnectionRemoved"})

#endif

-- signal Client::any-device-added
-- | Notifies that a t'GI.NM.Objects.Device.Device' is added.  This signal is emitted for both
-- regular devices and placeholder devices.
type ClientAnyDeviceAddedCallback =
    NM.Device.Device
    -- ^ /@device@/: the new device
    -> IO ()

type C_ClientAnyDeviceAddedCallback =
    Ptr Client ->                           -- object
    Ptr NM.Device.Device ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_ClientAnyDeviceAddedCallback`.
foreign import ccall "wrapper"
    mk_ClientAnyDeviceAddedCallback :: C_ClientAnyDeviceAddedCallback -> IO (FunPtr C_ClientAnyDeviceAddedCallback)

wrap_ClientAnyDeviceAddedCallback :: 
    GObject a => (a -> ClientAnyDeviceAddedCallback) ->
    C_ClientAnyDeviceAddedCallback
wrap_ClientAnyDeviceAddedCallback :: forall a.
GObject a =>
(a -> ClientAnyDeviceAddedCallback)
-> C_ClientAnyDeviceAddedCallback
wrap_ClientAnyDeviceAddedCallback a -> ClientAnyDeviceAddedCallback
gi'cb Ptr Client
gi'selfPtr Ptr Device
device Ptr ()
_ = do
    Device
device' <- ((ManagedPtr Device -> Device) -> Ptr Device -> IO Device
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Device -> Device
NM.Device.Device) Ptr Device
device
    Ptr Client -> (Client -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr Client
gi'selfPtr ((Client -> IO ()) -> IO ()) -> (Client -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Client
gi'self -> a -> ClientAnyDeviceAddedCallback
gi'cb (Client -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Client
gi'self)  Device
device'


-- | Connect a signal handler for the [anyDeviceAdded](#signal:anyDeviceAdded) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' client #anyDeviceAdded callback
-- @
-- 
-- 
onClientAnyDeviceAdded :: (IsClient a, MonadIO m) => a -> ((?self :: a) => ClientAnyDeviceAddedCallback) -> m SignalHandlerId
onClientAnyDeviceAdded :: forall a (m :: * -> *).
(IsClient a, MonadIO m) =>
a
-> ((?self::a) => ClientAnyDeviceAddedCallback)
-> m SignalHandlerId
onClientAnyDeviceAdded a
obj (?self::a) => ClientAnyDeviceAddedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ClientAnyDeviceAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ClientAnyDeviceAddedCallback
ClientAnyDeviceAddedCallback
cb
    let wrapped' :: C_ClientAnyDeviceAddedCallback
wrapped' = (a -> ClientAnyDeviceAddedCallback)
-> C_ClientAnyDeviceAddedCallback
forall a.
GObject a =>
(a -> ClientAnyDeviceAddedCallback)
-> C_ClientAnyDeviceAddedCallback
wrap_ClientAnyDeviceAddedCallback a -> ClientAnyDeviceAddedCallback
wrapped
    FunPtr C_ClientAnyDeviceAddedCallback
wrapped'' <- C_ClientAnyDeviceAddedCallback
-> IO (FunPtr C_ClientAnyDeviceAddedCallback)
mk_ClientAnyDeviceAddedCallback C_ClientAnyDeviceAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_ClientAnyDeviceAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"any-device-added" FunPtr C_ClientAnyDeviceAddedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [anyDeviceAdded](#signal:anyDeviceAdded) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' client #anyDeviceAdded callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterClientAnyDeviceAdded :: (IsClient a, MonadIO m) => a -> ((?self :: a) => ClientAnyDeviceAddedCallback) -> m SignalHandlerId
afterClientAnyDeviceAdded :: forall a (m :: * -> *).
(IsClient a, MonadIO m) =>
a
-> ((?self::a) => ClientAnyDeviceAddedCallback)
-> m SignalHandlerId
afterClientAnyDeviceAdded a
obj (?self::a) => ClientAnyDeviceAddedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ClientAnyDeviceAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ClientAnyDeviceAddedCallback
ClientAnyDeviceAddedCallback
cb
    let wrapped' :: C_ClientAnyDeviceAddedCallback
wrapped' = (a -> ClientAnyDeviceAddedCallback)
-> C_ClientAnyDeviceAddedCallback
forall a.
GObject a =>
(a -> ClientAnyDeviceAddedCallback)
-> C_ClientAnyDeviceAddedCallback
wrap_ClientAnyDeviceAddedCallback a -> ClientAnyDeviceAddedCallback
wrapped
    FunPtr C_ClientAnyDeviceAddedCallback
wrapped'' <- C_ClientAnyDeviceAddedCallback
-> IO (FunPtr C_ClientAnyDeviceAddedCallback)
mk_ClientAnyDeviceAddedCallback C_ClientAnyDeviceAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_ClientAnyDeviceAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"any-device-added" FunPtr C_ClientAnyDeviceAddedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ClientAnyDeviceAddedSignalInfo
instance SignalInfo ClientAnyDeviceAddedSignalInfo where
    type HaskellCallbackType ClientAnyDeviceAddedSignalInfo = ClientAnyDeviceAddedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ClientAnyDeviceAddedCallback cb
        cb'' <- mk_ClientAnyDeviceAddedCallback cb'
        connectSignalFunPtr obj "any-device-added" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client::any-device-added"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#g:signal:anyDeviceAdded"})

#endif

-- signal Client::any-device-removed
-- | Notifies that a t'GI.NM.Objects.Device.Device' is removed.  This signal is emitted for both
-- regular devices and placeholder devices.
type ClientAnyDeviceRemovedCallback =
    NM.Device.Device
    -- ^ /@device@/: the removed device
    -> IO ()

type C_ClientAnyDeviceRemovedCallback =
    Ptr Client ->                           -- object
    Ptr NM.Device.Device ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_ClientAnyDeviceRemovedCallback`.
foreign import ccall "wrapper"
    mk_ClientAnyDeviceRemovedCallback :: C_ClientAnyDeviceRemovedCallback -> IO (FunPtr C_ClientAnyDeviceRemovedCallback)

wrap_ClientAnyDeviceRemovedCallback :: 
    GObject a => (a -> ClientAnyDeviceRemovedCallback) ->
    C_ClientAnyDeviceRemovedCallback
wrap_ClientAnyDeviceRemovedCallback :: forall a.
GObject a =>
(a -> ClientAnyDeviceAddedCallback)
-> C_ClientAnyDeviceAddedCallback
wrap_ClientAnyDeviceRemovedCallback a -> ClientAnyDeviceAddedCallback
gi'cb Ptr Client
gi'selfPtr Ptr Device
device Ptr ()
_ = do
    Device
device' <- ((ManagedPtr Device -> Device) -> Ptr Device -> IO Device
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Device -> Device
NM.Device.Device) Ptr Device
device
    Ptr Client -> (Client -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr Client
gi'selfPtr ((Client -> IO ()) -> IO ()) -> (Client -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Client
gi'self -> a -> ClientAnyDeviceAddedCallback
gi'cb (Client -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Client
gi'self)  Device
device'


-- | Connect a signal handler for the [anyDeviceRemoved](#signal:anyDeviceRemoved) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' client #anyDeviceRemoved callback
-- @
-- 
-- 
onClientAnyDeviceRemoved :: (IsClient a, MonadIO m) => a -> ((?self :: a) => ClientAnyDeviceRemovedCallback) -> m SignalHandlerId
onClientAnyDeviceRemoved :: forall a (m :: * -> *).
(IsClient a, MonadIO m) =>
a
-> ((?self::a) => ClientAnyDeviceAddedCallback)
-> m SignalHandlerId
onClientAnyDeviceRemoved a
obj (?self::a) => ClientAnyDeviceAddedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ClientAnyDeviceAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ClientAnyDeviceAddedCallback
ClientAnyDeviceAddedCallback
cb
    let wrapped' :: C_ClientAnyDeviceAddedCallback
wrapped' = (a -> ClientAnyDeviceAddedCallback)
-> C_ClientAnyDeviceAddedCallback
forall a.
GObject a =>
(a -> ClientAnyDeviceAddedCallback)
-> C_ClientAnyDeviceAddedCallback
wrap_ClientAnyDeviceRemovedCallback a -> ClientAnyDeviceAddedCallback
wrapped
    FunPtr C_ClientAnyDeviceAddedCallback
wrapped'' <- C_ClientAnyDeviceAddedCallback
-> IO (FunPtr C_ClientAnyDeviceAddedCallback)
mk_ClientAnyDeviceRemovedCallback C_ClientAnyDeviceAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_ClientAnyDeviceAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"any-device-removed" FunPtr C_ClientAnyDeviceAddedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [anyDeviceRemoved](#signal:anyDeviceRemoved) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' client #anyDeviceRemoved callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterClientAnyDeviceRemoved :: (IsClient a, MonadIO m) => a -> ((?self :: a) => ClientAnyDeviceRemovedCallback) -> m SignalHandlerId
afterClientAnyDeviceRemoved :: forall a (m :: * -> *).
(IsClient a, MonadIO m) =>
a
-> ((?self::a) => ClientAnyDeviceAddedCallback)
-> m SignalHandlerId
afterClientAnyDeviceRemoved a
obj (?self::a) => ClientAnyDeviceAddedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ClientAnyDeviceAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ClientAnyDeviceAddedCallback
ClientAnyDeviceAddedCallback
cb
    let wrapped' :: C_ClientAnyDeviceAddedCallback
wrapped' = (a -> ClientAnyDeviceAddedCallback)
-> C_ClientAnyDeviceAddedCallback
forall a.
GObject a =>
(a -> ClientAnyDeviceAddedCallback)
-> C_ClientAnyDeviceAddedCallback
wrap_ClientAnyDeviceRemovedCallback a -> ClientAnyDeviceAddedCallback
wrapped
    FunPtr C_ClientAnyDeviceAddedCallback
wrapped'' <- C_ClientAnyDeviceAddedCallback
-> IO (FunPtr C_ClientAnyDeviceAddedCallback)
mk_ClientAnyDeviceRemovedCallback C_ClientAnyDeviceAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_ClientAnyDeviceAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"any-device-removed" FunPtr C_ClientAnyDeviceAddedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ClientAnyDeviceRemovedSignalInfo
instance SignalInfo ClientAnyDeviceRemovedSignalInfo where
    type HaskellCallbackType ClientAnyDeviceRemovedSignalInfo = ClientAnyDeviceRemovedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ClientAnyDeviceRemovedCallback cb
        cb'' <- mk_ClientAnyDeviceRemovedCallback cb'
        connectSignalFunPtr obj "any-device-removed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client::any-device-removed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#g:signal:anyDeviceRemoved"})

#endif

-- signal Client::connection-added
-- | Notifies that a t'GI.NM.Interfaces.Connection.Connection' has been added.
type ClientConnectionAddedCallback =
    NM.RemoteConnection.RemoteConnection
    -- ^ /@connection@/: the new connection
    -> IO ()

type C_ClientConnectionAddedCallback =
    Ptr Client ->                           -- object
    Ptr NM.RemoteConnection.RemoteConnection ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_ClientConnectionAddedCallback`.
foreign import ccall "wrapper"
    mk_ClientConnectionAddedCallback :: C_ClientConnectionAddedCallback -> IO (FunPtr C_ClientConnectionAddedCallback)

wrap_ClientConnectionAddedCallback :: 
    GObject a => (a -> ClientConnectionAddedCallback) ->
    C_ClientConnectionAddedCallback
wrap_ClientConnectionAddedCallback :: forall a.
GObject a =>
(a -> ClientConnectionAddedCallback)
-> C_ClientConnectionAddedCallback
wrap_ClientConnectionAddedCallback a -> ClientConnectionAddedCallback
gi'cb Ptr Client
gi'selfPtr Ptr RemoteConnection
connection Ptr ()
_ = do
    RemoteConnection
connection' <- ((ManagedPtr RemoteConnection -> RemoteConnection)
-> Ptr RemoteConnection -> IO RemoteConnection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr RemoteConnection -> RemoteConnection
NM.RemoteConnection.RemoteConnection) Ptr RemoteConnection
connection
    Ptr Client -> (Client -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr Client
gi'selfPtr ((Client -> IO ()) -> IO ()) -> (Client -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Client
gi'self -> a -> ClientConnectionAddedCallback
gi'cb (Client -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Client
gi'self)  RemoteConnection
connection'


-- | Connect a signal handler for the [connectionAdded](#signal:connectionAdded) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' client #connectionAdded callback
-- @
-- 
-- 
onClientConnectionAdded :: (IsClient a, MonadIO m) => a -> ((?self :: a) => ClientConnectionAddedCallback) -> m SignalHandlerId
onClientConnectionAdded :: forall a (m :: * -> *).
(IsClient a, MonadIO m) =>
a
-> ((?self::a) => ClientConnectionAddedCallback)
-> m SignalHandlerId
onClientConnectionAdded a
obj (?self::a) => ClientConnectionAddedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ClientConnectionAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ClientConnectionAddedCallback
ClientConnectionAddedCallback
cb
    let wrapped' :: C_ClientConnectionAddedCallback
wrapped' = (a -> ClientConnectionAddedCallback)
-> C_ClientConnectionAddedCallback
forall a.
GObject a =>
(a -> ClientConnectionAddedCallback)
-> C_ClientConnectionAddedCallback
wrap_ClientConnectionAddedCallback a -> ClientConnectionAddedCallback
wrapped
    FunPtr C_ClientConnectionAddedCallback
wrapped'' <- C_ClientConnectionAddedCallback
-> IO (FunPtr C_ClientConnectionAddedCallback)
mk_ClientConnectionAddedCallback C_ClientConnectionAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_ClientConnectionAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"connection-added" FunPtr C_ClientConnectionAddedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [connectionAdded](#signal:connectionAdded) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' client #connectionAdded callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterClientConnectionAdded :: (IsClient a, MonadIO m) => a -> ((?self :: a) => ClientConnectionAddedCallback) -> m SignalHandlerId
afterClientConnectionAdded :: forall a (m :: * -> *).
(IsClient a, MonadIO m) =>
a
-> ((?self::a) => ClientConnectionAddedCallback)
-> m SignalHandlerId
afterClientConnectionAdded a
obj (?self::a) => ClientConnectionAddedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ClientConnectionAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ClientConnectionAddedCallback
ClientConnectionAddedCallback
cb
    let wrapped' :: C_ClientConnectionAddedCallback
wrapped' = (a -> ClientConnectionAddedCallback)
-> C_ClientConnectionAddedCallback
forall a.
GObject a =>
(a -> ClientConnectionAddedCallback)
-> C_ClientConnectionAddedCallback
wrap_ClientConnectionAddedCallback a -> ClientConnectionAddedCallback
wrapped
    FunPtr C_ClientConnectionAddedCallback
wrapped'' <- C_ClientConnectionAddedCallback
-> IO (FunPtr C_ClientConnectionAddedCallback)
mk_ClientConnectionAddedCallback C_ClientConnectionAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_ClientConnectionAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"connection-added" FunPtr C_ClientConnectionAddedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ClientConnectionAddedSignalInfo
instance SignalInfo ClientConnectionAddedSignalInfo where
    type HaskellCallbackType ClientConnectionAddedSignalInfo = ClientConnectionAddedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ClientConnectionAddedCallback cb
        cb'' <- mk_ClientConnectionAddedCallback cb'
        connectSignalFunPtr obj "connection-added" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client::connection-added"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#g:signal:connectionAdded"})

#endif

-- signal Client::connection-removed
-- | Notifies that a t'GI.NM.Interfaces.Connection.Connection' has been removed.
type ClientConnectionRemovedCallback =
    NM.RemoteConnection.RemoteConnection
    -- ^ /@connection@/: the removed connection
    -> IO ()

type C_ClientConnectionRemovedCallback =
    Ptr Client ->                           -- object
    Ptr NM.RemoteConnection.RemoteConnection ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_ClientConnectionRemovedCallback`.
foreign import ccall "wrapper"
    mk_ClientConnectionRemovedCallback :: C_ClientConnectionRemovedCallback -> IO (FunPtr C_ClientConnectionRemovedCallback)

wrap_ClientConnectionRemovedCallback :: 
    GObject a => (a -> ClientConnectionRemovedCallback) ->
    C_ClientConnectionRemovedCallback
wrap_ClientConnectionRemovedCallback :: forall a.
GObject a =>
(a -> ClientConnectionAddedCallback)
-> C_ClientConnectionAddedCallback
wrap_ClientConnectionRemovedCallback a -> ClientConnectionAddedCallback
gi'cb Ptr Client
gi'selfPtr Ptr RemoteConnection
connection Ptr ()
_ = do
    RemoteConnection
connection' <- ((ManagedPtr RemoteConnection -> RemoteConnection)
-> Ptr RemoteConnection -> IO RemoteConnection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr RemoteConnection -> RemoteConnection
NM.RemoteConnection.RemoteConnection) Ptr RemoteConnection
connection
    Ptr Client -> (Client -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr Client
gi'selfPtr ((Client -> IO ()) -> IO ()) -> (Client -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Client
gi'self -> a -> ClientConnectionAddedCallback
gi'cb (Client -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Client
gi'self)  RemoteConnection
connection'


-- | Connect a signal handler for the [connectionRemoved](#signal:connectionRemoved) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' client #connectionRemoved callback
-- @
-- 
-- 
onClientConnectionRemoved :: (IsClient a, MonadIO m) => a -> ((?self :: a) => ClientConnectionRemovedCallback) -> m SignalHandlerId
onClientConnectionRemoved :: forall a (m :: * -> *).
(IsClient a, MonadIO m) =>
a
-> ((?self::a) => ClientConnectionAddedCallback)
-> m SignalHandlerId
onClientConnectionRemoved a
obj (?self::a) => ClientConnectionAddedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ClientConnectionAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ClientConnectionAddedCallback
ClientConnectionAddedCallback
cb
    let wrapped' :: C_ClientConnectionAddedCallback
wrapped' = (a -> ClientConnectionAddedCallback)
-> C_ClientConnectionAddedCallback
forall a.
GObject a =>
(a -> ClientConnectionAddedCallback)
-> C_ClientConnectionAddedCallback
wrap_ClientConnectionRemovedCallback a -> ClientConnectionAddedCallback
wrapped
    FunPtr C_ClientConnectionAddedCallback
wrapped'' <- C_ClientConnectionAddedCallback
-> IO (FunPtr C_ClientConnectionAddedCallback)
mk_ClientConnectionRemovedCallback C_ClientConnectionAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_ClientConnectionAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"connection-removed" FunPtr C_ClientConnectionAddedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [connectionRemoved](#signal:connectionRemoved) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' client #connectionRemoved callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterClientConnectionRemoved :: (IsClient a, MonadIO m) => a -> ((?self :: a) => ClientConnectionRemovedCallback) -> m SignalHandlerId
afterClientConnectionRemoved :: forall a (m :: * -> *).
(IsClient a, MonadIO m) =>
a
-> ((?self::a) => ClientConnectionAddedCallback)
-> m SignalHandlerId
afterClientConnectionRemoved a
obj (?self::a) => ClientConnectionAddedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ClientConnectionAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ClientConnectionAddedCallback
ClientConnectionAddedCallback
cb
    let wrapped' :: C_ClientConnectionAddedCallback
wrapped' = (a -> ClientConnectionAddedCallback)
-> C_ClientConnectionAddedCallback
forall a.
GObject a =>
(a -> ClientConnectionAddedCallback)
-> C_ClientConnectionAddedCallback
wrap_ClientConnectionRemovedCallback a -> ClientConnectionAddedCallback
wrapped
    FunPtr C_ClientConnectionAddedCallback
wrapped'' <- C_ClientConnectionAddedCallback
-> IO (FunPtr C_ClientConnectionAddedCallback)
mk_ClientConnectionRemovedCallback C_ClientConnectionAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_ClientConnectionAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"connection-removed" FunPtr C_ClientConnectionAddedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ClientConnectionRemovedSignalInfo
instance SignalInfo ClientConnectionRemovedSignalInfo where
    type HaskellCallbackType ClientConnectionRemovedSignalInfo = ClientConnectionRemovedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ClientConnectionRemovedCallback cb
        cb'' <- mk_ClientConnectionRemovedCallback cb'
        connectSignalFunPtr obj "connection-removed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client::connection-removed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#g:signal:connectionRemoved"})

#endif

-- signal Client::device-added
-- | Notifies that a t'GI.NM.Objects.Device.Device' is added.  This signal is not emitted for
-- placeholder devices.
type ClientDeviceAddedCallback =
    NM.Device.Device
    -- ^ /@device@/: the new device
    -> IO ()

type C_ClientDeviceAddedCallback =
    Ptr Client ->                           -- object
    Ptr NM.Device.Device ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_ClientDeviceAddedCallback`.
foreign import ccall "wrapper"
    mk_ClientDeviceAddedCallback :: C_ClientDeviceAddedCallback -> IO (FunPtr C_ClientDeviceAddedCallback)

wrap_ClientDeviceAddedCallback :: 
    GObject a => (a -> ClientDeviceAddedCallback) ->
    C_ClientDeviceAddedCallback
wrap_ClientDeviceAddedCallback :: forall a.
GObject a =>
(a -> ClientAnyDeviceAddedCallback)
-> C_ClientAnyDeviceAddedCallback
wrap_ClientDeviceAddedCallback a -> ClientAnyDeviceAddedCallback
gi'cb Ptr Client
gi'selfPtr Ptr Device
device Ptr ()
_ = do
    Device
device' <- ((ManagedPtr Device -> Device) -> Ptr Device -> IO Device
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Device -> Device
NM.Device.Device) Ptr Device
device
    Ptr Client -> (Client -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr Client
gi'selfPtr ((Client -> IO ()) -> IO ()) -> (Client -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Client
gi'self -> a -> ClientAnyDeviceAddedCallback
gi'cb (Client -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Client
gi'self)  Device
device'


-- | Connect a signal handler for the [deviceAdded](#signal:deviceAdded) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' client #deviceAdded callback
-- @
-- 
-- 
onClientDeviceAdded :: (IsClient a, MonadIO m) => a -> ((?self :: a) => ClientDeviceAddedCallback) -> m SignalHandlerId
onClientDeviceAdded :: forall a (m :: * -> *).
(IsClient a, MonadIO m) =>
a
-> ((?self::a) => ClientAnyDeviceAddedCallback)
-> m SignalHandlerId
onClientDeviceAdded a
obj (?self::a) => ClientAnyDeviceAddedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ClientAnyDeviceAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ClientAnyDeviceAddedCallback
ClientAnyDeviceAddedCallback
cb
    let wrapped' :: C_ClientAnyDeviceAddedCallback
wrapped' = (a -> ClientAnyDeviceAddedCallback)
-> C_ClientAnyDeviceAddedCallback
forall a.
GObject a =>
(a -> ClientAnyDeviceAddedCallback)
-> C_ClientAnyDeviceAddedCallback
wrap_ClientDeviceAddedCallback a -> ClientAnyDeviceAddedCallback
wrapped
    FunPtr C_ClientAnyDeviceAddedCallback
wrapped'' <- C_ClientAnyDeviceAddedCallback
-> IO (FunPtr C_ClientAnyDeviceAddedCallback)
mk_ClientDeviceAddedCallback C_ClientAnyDeviceAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_ClientAnyDeviceAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"device-added" FunPtr C_ClientAnyDeviceAddedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [deviceAdded](#signal:deviceAdded) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' client #deviceAdded callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterClientDeviceAdded :: (IsClient a, MonadIO m) => a -> ((?self :: a) => ClientDeviceAddedCallback) -> m SignalHandlerId
afterClientDeviceAdded :: forall a (m :: * -> *).
(IsClient a, MonadIO m) =>
a
-> ((?self::a) => ClientAnyDeviceAddedCallback)
-> m SignalHandlerId
afterClientDeviceAdded a
obj (?self::a) => ClientAnyDeviceAddedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ClientAnyDeviceAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ClientAnyDeviceAddedCallback
ClientAnyDeviceAddedCallback
cb
    let wrapped' :: C_ClientAnyDeviceAddedCallback
wrapped' = (a -> ClientAnyDeviceAddedCallback)
-> C_ClientAnyDeviceAddedCallback
forall a.
GObject a =>
(a -> ClientAnyDeviceAddedCallback)
-> C_ClientAnyDeviceAddedCallback
wrap_ClientDeviceAddedCallback a -> ClientAnyDeviceAddedCallback
wrapped
    FunPtr C_ClientAnyDeviceAddedCallback
wrapped'' <- C_ClientAnyDeviceAddedCallback
-> IO (FunPtr C_ClientAnyDeviceAddedCallback)
mk_ClientDeviceAddedCallback C_ClientAnyDeviceAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_ClientAnyDeviceAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"device-added" FunPtr C_ClientAnyDeviceAddedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ClientDeviceAddedSignalInfo
instance SignalInfo ClientDeviceAddedSignalInfo where
    type HaskellCallbackType ClientDeviceAddedSignalInfo = ClientDeviceAddedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ClientDeviceAddedCallback cb
        cb'' <- mk_ClientDeviceAddedCallback cb'
        connectSignalFunPtr obj "device-added" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client::device-added"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#g:signal:deviceAdded"})

#endif

-- signal Client::device-removed
-- | Notifies that a t'GI.NM.Objects.Device.Device' is removed.  This signal is not emitted for
-- placeholder devices.
type ClientDeviceRemovedCallback =
    NM.Device.Device
    -- ^ /@device@/: the removed device
    -> IO ()

type C_ClientDeviceRemovedCallback =
    Ptr Client ->                           -- object
    Ptr NM.Device.Device ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_ClientDeviceRemovedCallback`.
foreign import ccall "wrapper"
    mk_ClientDeviceRemovedCallback :: C_ClientDeviceRemovedCallback -> IO (FunPtr C_ClientDeviceRemovedCallback)

wrap_ClientDeviceRemovedCallback :: 
    GObject a => (a -> ClientDeviceRemovedCallback) ->
    C_ClientDeviceRemovedCallback
wrap_ClientDeviceRemovedCallback :: forall a.
GObject a =>
(a -> ClientAnyDeviceAddedCallback)
-> C_ClientAnyDeviceAddedCallback
wrap_ClientDeviceRemovedCallback a -> ClientAnyDeviceAddedCallback
gi'cb Ptr Client
gi'selfPtr Ptr Device
device Ptr ()
_ = do
    Device
device' <- ((ManagedPtr Device -> Device) -> Ptr Device -> IO Device
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Device -> Device
NM.Device.Device) Ptr Device
device
    Ptr Client -> (Client -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr Client
gi'selfPtr ((Client -> IO ()) -> IO ()) -> (Client -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Client
gi'self -> a -> ClientAnyDeviceAddedCallback
gi'cb (Client -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Client
gi'self)  Device
device'


-- | Connect a signal handler for the [deviceRemoved](#signal:deviceRemoved) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' client #deviceRemoved callback
-- @
-- 
-- 
onClientDeviceRemoved :: (IsClient a, MonadIO m) => a -> ((?self :: a) => ClientDeviceRemovedCallback) -> m SignalHandlerId
onClientDeviceRemoved :: forall a (m :: * -> *).
(IsClient a, MonadIO m) =>
a
-> ((?self::a) => ClientAnyDeviceAddedCallback)
-> m SignalHandlerId
onClientDeviceRemoved a
obj (?self::a) => ClientAnyDeviceAddedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ClientAnyDeviceAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ClientAnyDeviceAddedCallback
ClientAnyDeviceAddedCallback
cb
    let wrapped' :: C_ClientAnyDeviceAddedCallback
wrapped' = (a -> ClientAnyDeviceAddedCallback)
-> C_ClientAnyDeviceAddedCallback
forall a.
GObject a =>
(a -> ClientAnyDeviceAddedCallback)
-> C_ClientAnyDeviceAddedCallback
wrap_ClientDeviceRemovedCallback a -> ClientAnyDeviceAddedCallback
wrapped
    FunPtr C_ClientAnyDeviceAddedCallback
wrapped'' <- C_ClientAnyDeviceAddedCallback
-> IO (FunPtr C_ClientAnyDeviceAddedCallback)
mk_ClientDeviceRemovedCallback C_ClientAnyDeviceAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_ClientAnyDeviceAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"device-removed" FunPtr C_ClientAnyDeviceAddedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [deviceRemoved](#signal:deviceRemoved) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' client #deviceRemoved callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterClientDeviceRemoved :: (IsClient a, MonadIO m) => a -> ((?self :: a) => ClientDeviceRemovedCallback) -> m SignalHandlerId
afterClientDeviceRemoved :: forall a (m :: * -> *).
(IsClient a, MonadIO m) =>
a
-> ((?self::a) => ClientAnyDeviceAddedCallback)
-> m SignalHandlerId
afterClientDeviceRemoved a
obj (?self::a) => ClientAnyDeviceAddedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ClientAnyDeviceAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ClientAnyDeviceAddedCallback
ClientAnyDeviceAddedCallback
cb
    let wrapped' :: C_ClientAnyDeviceAddedCallback
wrapped' = (a -> ClientAnyDeviceAddedCallback)
-> C_ClientAnyDeviceAddedCallback
forall a.
GObject a =>
(a -> ClientAnyDeviceAddedCallback)
-> C_ClientAnyDeviceAddedCallback
wrap_ClientDeviceRemovedCallback a -> ClientAnyDeviceAddedCallback
wrapped
    FunPtr C_ClientAnyDeviceAddedCallback
wrapped'' <- C_ClientAnyDeviceAddedCallback
-> IO (FunPtr C_ClientAnyDeviceAddedCallback)
mk_ClientDeviceRemovedCallback C_ClientAnyDeviceAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_ClientAnyDeviceAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"device-removed" FunPtr C_ClientAnyDeviceAddedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ClientDeviceRemovedSignalInfo
instance SignalInfo ClientDeviceRemovedSignalInfo where
    type HaskellCallbackType ClientDeviceRemovedSignalInfo = ClientDeviceRemovedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ClientDeviceRemovedCallback cb
        cb'' <- mk_ClientDeviceRemovedCallback cb'
        connectSignalFunPtr obj "device-removed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client::device-removed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#g:signal:deviceRemoved"})

#endif

-- signal Client::permission-changed
-- | Notifies that a permission has changed
type ClientPermissionChangedCallback =
    Word32
    -- ^ /@permission@/: a permission from t'GI.NM.Enums.ClientPermission'
    -> Word32
    -- ^ /@result@/: the permission\'s result, one of t'GI.NM.Enums.ClientPermissionResult'
    -> IO ()

type C_ClientPermissionChangedCallback =
    Ptr Client ->                           -- object
    Word32 ->
    Word32 ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_ClientPermissionChangedCallback`.
foreign import ccall "wrapper"
    mk_ClientPermissionChangedCallback :: C_ClientPermissionChangedCallback -> IO (FunPtr C_ClientPermissionChangedCallback)

wrap_ClientPermissionChangedCallback :: 
    GObject a => (a -> ClientPermissionChangedCallback) ->
    C_ClientPermissionChangedCallback
wrap_ClientPermissionChangedCallback :: forall a.
GObject a =>
(a -> ClientPermissionChangedCallback)
-> C_ClientPermissionChangedCallback
wrap_ClientPermissionChangedCallback a -> ClientPermissionChangedCallback
gi'cb Ptr Client
gi'selfPtr Word32
permission Word32
result_ Ptr ()
_ = do
    Ptr Client -> (Client -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr Client
gi'selfPtr ((Client -> IO ()) -> IO ()) -> (Client -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Client
gi'self -> a -> ClientPermissionChangedCallback
gi'cb (Client -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Client
gi'self)  Word32
permission Word32
result_


-- | Connect a signal handler for the [permissionChanged](#signal:permissionChanged) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' client #permissionChanged callback
-- @
-- 
-- 
onClientPermissionChanged :: (IsClient a, MonadIO m) => a -> ((?self :: a) => ClientPermissionChangedCallback) -> m SignalHandlerId
onClientPermissionChanged :: forall a (m :: * -> *).
(IsClient a, MonadIO m) =>
a
-> ((?self::a) => ClientPermissionChangedCallback)
-> m SignalHandlerId
onClientPermissionChanged a
obj (?self::a) => ClientPermissionChangedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ClientPermissionChangedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ClientPermissionChangedCallback
ClientPermissionChangedCallback
cb
    let wrapped' :: C_ClientPermissionChangedCallback
wrapped' = (a -> ClientPermissionChangedCallback)
-> C_ClientPermissionChangedCallback
forall a.
GObject a =>
(a -> ClientPermissionChangedCallback)
-> C_ClientPermissionChangedCallback
wrap_ClientPermissionChangedCallback a -> ClientPermissionChangedCallback
wrapped
    FunPtr C_ClientPermissionChangedCallback
wrapped'' <- C_ClientPermissionChangedCallback
-> IO (FunPtr C_ClientPermissionChangedCallback)
mk_ClientPermissionChangedCallback C_ClientPermissionChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_ClientPermissionChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"permission-changed" FunPtr C_ClientPermissionChangedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [permissionChanged](#signal:permissionChanged) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' client #permissionChanged callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterClientPermissionChanged :: (IsClient a, MonadIO m) => a -> ((?self :: a) => ClientPermissionChangedCallback) -> m SignalHandlerId
afterClientPermissionChanged :: forall a (m :: * -> *).
(IsClient a, MonadIO m) =>
a
-> ((?self::a) => ClientPermissionChangedCallback)
-> m SignalHandlerId
afterClientPermissionChanged a
obj (?self::a) => ClientPermissionChangedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ClientPermissionChangedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ClientPermissionChangedCallback
ClientPermissionChangedCallback
cb
    let wrapped' :: C_ClientPermissionChangedCallback
wrapped' = (a -> ClientPermissionChangedCallback)
-> C_ClientPermissionChangedCallback
forall a.
GObject a =>
(a -> ClientPermissionChangedCallback)
-> C_ClientPermissionChangedCallback
wrap_ClientPermissionChangedCallback a -> ClientPermissionChangedCallback
wrapped
    FunPtr C_ClientPermissionChangedCallback
wrapped'' <- C_ClientPermissionChangedCallback
-> IO (FunPtr C_ClientPermissionChangedCallback)
mk_ClientPermissionChangedCallback C_ClientPermissionChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_ClientPermissionChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"permission-changed" FunPtr C_ClientPermissionChangedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ClientPermissionChangedSignalInfo
instance SignalInfo ClientPermissionChangedSignalInfo where
    type HaskellCallbackType ClientPermissionChangedSignalInfo = ClientPermissionChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ClientPermissionChangedCallback cb
        cb'' <- mk_ClientPermissionChangedCallback cb'
        connectSignalFunPtr obj "permission-changed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client::permission-changed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#g:signal:permissionChanged"})

#endif

-- VVV Prop "activating-connection"
   -- Type: TInterface (Name {namespace = "NM", name = "ActiveConnection"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@activating-connection@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' client #activatingConnection
-- @
getClientActivatingConnection :: (MonadIO m, IsClient o) => o -> m NM.ActiveConnection.ActiveConnection
getClientActivatingConnection :: forall (m :: * -> *) o.
(MonadIO m, IsClient o) =>
o -> m ActiveConnection
getClientActivatingConnection o
obj = IO ActiveConnection -> m ActiveConnection
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO ActiveConnection -> m ActiveConnection)
-> IO ActiveConnection -> m ActiveConnection
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe ActiveConnection) -> IO ActiveConnection
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getClientActivatingConnection" (IO (Maybe ActiveConnection) -> IO ActiveConnection)
-> IO (Maybe ActiveConnection) -> IO ActiveConnection
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr ActiveConnection -> ActiveConnection)
-> IO (Maybe ActiveConnection)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"activating-connection" ManagedPtr ActiveConnection -> ActiveConnection
NM.ActiveConnection.ActiveConnection

#if defined(ENABLE_OVERLOADING)
data ClientActivatingConnectionPropertyInfo
instance AttrInfo ClientActivatingConnectionPropertyInfo where
    type AttrAllowedOps ClientActivatingConnectionPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ClientActivatingConnectionPropertyInfo = IsClient
    type AttrSetTypeConstraint ClientActivatingConnectionPropertyInfo = (~) ()
    type AttrTransferTypeConstraint ClientActivatingConnectionPropertyInfo = (~) ()
    type AttrTransferType ClientActivatingConnectionPropertyInfo = ()
    type AttrGetType ClientActivatingConnectionPropertyInfo = NM.ActiveConnection.ActiveConnection
    type AttrLabel ClientActivatingConnectionPropertyInfo = "activating-connection"
    type AttrOrigin ClientActivatingConnectionPropertyInfo = Client
    attrGet = getClientActivatingConnection
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.activatingConnection"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#g:attr:activatingConnection"
        })
#endif

-- XXX Generation of property "active-connections" of object "Client" failed.
-- Not implemented: Don't know how to handle properties of type TPtrArray (TInterface (Name {namespace = "NM", name = "ActiveConnection"}))
#if defined(ENABLE_OVERLOADING)
-- XXX Placeholder
data ClientActiveConnectionsPropertyInfo
instance AttrInfo ClientActiveConnectionsPropertyInfo where
    type AttrAllowedOps ClientActiveConnectionsPropertyInfo = '[]
    type AttrSetTypeConstraint ClientActiveConnectionsPropertyInfo = (~) ()
    type AttrTransferTypeConstraint ClientActiveConnectionsPropertyInfo = (~) ()
    type AttrTransferType ClientActiveConnectionsPropertyInfo = ()
    type AttrBaseTypeConstraint ClientActiveConnectionsPropertyInfo = (~) ()
    type AttrGetType ClientActiveConnectionsPropertyInfo = ()
    type AttrLabel ClientActiveConnectionsPropertyInfo = ""
    type AttrOrigin ClientActiveConnectionsPropertyInfo = Client
    attrGet = undefined
    attrSet = undefined
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer = undefined
#endif

-- XXX Generation of property "all-devices" of object "Client" failed.
-- Not implemented: Don't know how to handle properties of type TPtrArray (TInterface (Name {namespace = "NM", name = "Device"}))
#if defined(ENABLE_OVERLOADING)
-- XXX Placeholder
data ClientAllDevicesPropertyInfo
instance AttrInfo ClientAllDevicesPropertyInfo where
    type AttrAllowedOps ClientAllDevicesPropertyInfo = '[]
    type AttrSetTypeConstraint ClientAllDevicesPropertyInfo = (~) ()
    type AttrTransferTypeConstraint ClientAllDevicesPropertyInfo = (~) ()
    type AttrTransferType ClientAllDevicesPropertyInfo = ()
    type AttrBaseTypeConstraint ClientAllDevicesPropertyInfo = (~) ()
    type AttrGetType ClientAllDevicesPropertyInfo = ()
    type AttrLabel ClientAllDevicesPropertyInfo = ""
    type AttrOrigin ClientAllDevicesPropertyInfo = Client
    attrGet = undefined
    attrSet = undefined
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer = undefined
#endif

-- VVV Prop "can-modify"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@can-modify@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' client #canModify
-- @
getClientCanModify :: (MonadIO m, IsClient o) => o -> m Bool
getClientCanModify :: forall (m :: * -> *) o. (MonadIO m, IsClient o) => o -> m Bool
getClientCanModify o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"can-modify"

#if defined(ENABLE_OVERLOADING)
data ClientCanModifyPropertyInfo
instance AttrInfo ClientCanModifyPropertyInfo where
    type AttrAllowedOps ClientCanModifyPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint ClientCanModifyPropertyInfo = IsClient
    type AttrSetTypeConstraint ClientCanModifyPropertyInfo = (~) ()
    type AttrTransferTypeConstraint ClientCanModifyPropertyInfo = (~) ()
    type AttrTransferType ClientCanModifyPropertyInfo = ()
    type AttrGetType ClientCanModifyPropertyInfo = Bool
    type AttrLabel ClientCanModifyPropertyInfo = "can-modify"
    type AttrOrigin ClientCanModifyPropertyInfo = Client
    attrGet = getClientCanModify
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.canModify"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#g:attr:canModify"
        })
#endif

-- XXX Generation of property "capabilities" of object "Client" failed.
-- Not implemented: Don't know how to handle properties of type TGArray (TBasicType TUInt32)
#if defined(ENABLE_OVERLOADING)
-- XXX Placeholder
data ClientCapabilitiesPropertyInfo
instance AttrInfo ClientCapabilitiesPropertyInfo where
    type AttrAllowedOps ClientCapabilitiesPropertyInfo = '[]
    type AttrSetTypeConstraint ClientCapabilitiesPropertyInfo = (~) ()
    type AttrTransferTypeConstraint ClientCapabilitiesPropertyInfo = (~) ()
    type AttrTransferType ClientCapabilitiesPropertyInfo = ()
    type AttrBaseTypeConstraint ClientCapabilitiesPropertyInfo = (~) ()
    type AttrGetType ClientCapabilitiesPropertyInfo = ()
    type AttrLabel ClientCapabilitiesPropertyInfo = ""
    type AttrOrigin ClientCapabilitiesPropertyInfo = Client
    attrGet = undefined
    attrSet = undefined
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer = undefined
#endif

-- XXX Generation of property "checkpoints" of object "Client" failed.
-- Not implemented: Don't know how to handle properties of type TPtrArray (TInterface (Name {namespace = "NM", name = "Checkpoint"}))
#if defined(ENABLE_OVERLOADING)
-- XXX Placeholder
data ClientCheckpointsPropertyInfo
instance AttrInfo ClientCheckpointsPropertyInfo where
    type AttrAllowedOps ClientCheckpointsPropertyInfo = '[]
    type AttrSetTypeConstraint ClientCheckpointsPropertyInfo = (~) ()
    type AttrTransferTypeConstraint ClientCheckpointsPropertyInfo = (~) ()
    type AttrTransferType ClientCheckpointsPropertyInfo = ()
    type AttrBaseTypeConstraint ClientCheckpointsPropertyInfo = (~) ()
    type AttrGetType ClientCheckpointsPropertyInfo = ()
    type AttrLabel ClientCheckpointsPropertyInfo = ""
    type AttrOrigin ClientCheckpointsPropertyInfo = Client
    attrGet = undefined
    attrSet = undefined
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer = undefined
#endif

-- XXX Generation of property "connections" of object "Client" failed.
-- Not implemented: Don't know how to handle properties of type TPtrArray (TInterface (Name {namespace = "NM", name = "RemoteConnection"}))
#if defined(ENABLE_OVERLOADING)
-- XXX Placeholder
data ClientConnectionsPropertyInfo
instance AttrInfo ClientConnectionsPropertyInfo where
    type AttrAllowedOps ClientConnectionsPropertyInfo = '[]
    type AttrSetTypeConstraint ClientConnectionsPropertyInfo = (~) ()
    type AttrTransferTypeConstraint ClientConnectionsPropertyInfo = (~) ()
    type AttrTransferType ClientConnectionsPropertyInfo = ()
    type AttrBaseTypeConstraint ClientConnectionsPropertyInfo = (~) ()
    type AttrGetType ClientConnectionsPropertyInfo = ()
    type AttrLabel ClientConnectionsPropertyInfo = ""
    type AttrOrigin ClientConnectionsPropertyInfo = Client
    attrGet = undefined
    attrSet = undefined
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer = undefined
#endif

-- VVV Prop "connectivity"
   -- Type: TInterface (Name {namespace = "NM", name = "ConnectivityState"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@connectivity@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' client #connectivity
-- @
getClientConnectivity :: (MonadIO m, IsClient o) => o -> m NM.Enums.ConnectivityState
getClientConnectivity :: forall (m :: * -> *) o.
(MonadIO m, IsClient o) =>
o -> m ConnectivityState
getClientConnectivity o
obj = IO ConnectivityState -> m ConnectivityState
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO ConnectivityState -> m ConnectivityState)
-> IO ConnectivityState -> m ConnectivityState
forall a b. (a -> b) -> a -> b
$ o -> String -> IO ConnectivityState
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"connectivity"

#if defined(ENABLE_OVERLOADING)
data ClientConnectivityPropertyInfo
instance AttrInfo ClientConnectivityPropertyInfo where
    type AttrAllowedOps ClientConnectivityPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint ClientConnectivityPropertyInfo = IsClient
    type AttrSetTypeConstraint ClientConnectivityPropertyInfo = (~) ()
    type AttrTransferTypeConstraint ClientConnectivityPropertyInfo = (~) ()
    type AttrTransferType ClientConnectivityPropertyInfo = ()
    type AttrGetType ClientConnectivityPropertyInfo = NM.Enums.ConnectivityState
    type AttrLabel ClientConnectivityPropertyInfo = "connectivity"
    type AttrOrigin ClientConnectivityPropertyInfo = Client
    attrGet = getClientConnectivity
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.connectivity"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#g:attr:connectivity"
        })
#endif

-- VVV Prop "connectivity-check-available"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@connectivity-check-available@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' client #connectivityCheckAvailable
-- @
getClientConnectivityCheckAvailable :: (MonadIO m, IsClient o) => o -> m Bool
getClientConnectivityCheckAvailable :: forall (m :: * -> *) o. (MonadIO m, IsClient o) => o -> m Bool
getClientConnectivityCheckAvailable o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"connectivity-check-available"

#if defined(ENABLE_OVERLOADING)
data ClientConnectivityCheckAvailablePropertyInfo
instance AttrInfo ClientConnectivityCheckAvailablePropertyInfo where
    type AttrAllowedOps ClientConnectivityCheckAvailablePropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint ClientConnectivityCheckAvailablePropertyInfo = IsClient
    type AttrSetTypeConstraint ClientConnectivityCheckAvailablePropertyInfo = (~) ()
    type AttrTransferTypeConstraint ClientConnectivityCheckAvailablePropertyInfo = (~) ()
    type AttrTransferType ClientConnectivityCheckAvailablePropertyInfo = ()
    type AttrGetType ClientConnectivityCheckAvailablePropertyInfo = Bool
    type AttrLabel ClientConnectivityCheckAvailablePropertyInfo = "connectivity-check-available"
    type AttrOrigin ClientConnectivityCheckAvailablePropertyInfo = Client
    attrGet = getClientConnectivityCheckAvailable
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.connectivityCheckAvailable"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#g:attr:connectivityCheckAvailable"
        })
#endif

-- VVV Prop "connectivity-check-enabled"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@connectivity-check-enabled@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' client #connectivityCheckEnabled
-- @
getClientConnectivityCheckEnabled :: (MonadIO m, IsClient o) => o -> m Bool
getClientConnectivityCheckEnabled :: forall (m :: * -> *) o. (MonadIO m, IsClient o) => o -> m Bool
getClientConnectivityCheckEnabled o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"connectivity-check-enabled"

-- | Set the value of the “@connectivity-check-enabled@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' client [ #connectivityCheckEnabled 'Data.GI.Base.Attributes.:=' value ]
-- @
setClientConnectivityCheckEnabled :: (MonadIO m, IsClient o) => o -> Bool -> m ()
setClientConnectivityCheckEnabled :: forall (m :: * -> *) o.
(MonadIO m, IsClient o) =>
o -> Bool -> m ()
setClientConnectivityCheckEnabled o
obj Bool
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"connectivity-check-enabled" Bool
val

-- | Construct a t'GValueConstruct' with valid value for the “@connectivity-check-enabled@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructClientConnectivityCheckEnabled :: (IsClient o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructClientConnectivityCheckEnabled :: forall o (m :: * -> *).
(IsClient o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructClientConnectivityCheckEnabled Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"connectivity-check-enabled" Bool
val

#if defined(ENABLE_OVERLOADING)
data ClientConnectivityCheckEnabledPropertyInfo
instance AttrInfo ClientConnectivityCheckEnabledPropertyInfo where
    type AttrAllowedOps ClientConnectivityCheckEnabledPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ClientConnectivityCheckEnabledPropertyInfo = IsClient
    type AttrSetTypeConstraint ClientConnectivityCheckEnabledPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint ClientConnectivityCheckEnabledPropertyInfo = (~) Bool
    type AttrTransferType ClientConnectivityCheckEnabledPropertyInfo = Bool
    type AttrGetType ClientConnectivityCheckEnabledPropertyInfo = Bool
    type AttrLabel ClientConnectivityCheckEnabledPropertyInfo = "connectivity-check-enabled"
    type AttrOrigin ClientConnectivityCheckEnabledPropertyInfo = Client
    attrGet = getClientConnectivityCheckEnabled
    attrSet = setClientConnectivityCheckEnabled
    attrTransfer _ v = do
        return v
    attrConstruct = constructClientConnectivityCheckEnabled
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.connectivityCheckEnabled"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#g:attr:connectivityCheckEnabled"
        })
#endif

-- VVV Prop "connectivity-check-uri"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@connectivity-check-uri@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' client #connectivityCheckUri
-- @
getClientConnectivityCheckUri :: (MonadIO m, IsClient o) => o -> m (Maybe T.Text)
getClientConnectivityCheckUri :: forall (m :: * -> *) o.
(MonadIO m, IsClient o) =>
o -> m (Maybe Text)
getClientConnectivityCheckUri o
obj = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"connectivity-check-uri"

#if defined(ENABLE_OVERLOADING)
data ClientConnectivityCheckUriPropertyInfo
instance AttrInfo ClientConnectivityCheckUriPropertyInfo where
    type AttrAllowedOps ClientConnectivityCheckUriPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ClientConnectivityCheckUriPropertyInfo = IsClient
    type AttrSetTypeConstraint ClientConnectivityCheckUriPropertyInfo = (~) ()
    type AttrTransferTypeConstraint ClientConnectivityCheckUriPropertyInfo = (~) ()
    type AttrTransferType ClientConnectivityCheckUriPropertyInfo = ()
    type AttrGetType ClientConnectivityCheckUriPropertyInfo = (Maybe T.Text)
    type AttrLabel ClientConnectivityCheckUriPropertyInfo = "connectivity-check-uri"
    type AttrOrigin ClientConnectivityCheckUriPropertyInfo = Client
    attrGet = getClientConnectivityCheckUri
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.connectivityCheckUri"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#g:attr:connectivityCheckUri"
        })
#endif

-- VVV Prop "dbus-connection"
   -- Type: TInterface (Name {namespace = "Gio", name = "DBusConnection"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@dbus-connection@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' client #dbusConnection
-- @
getClientDbusConnection :: (MonadIO m, IsClient o) => o -> m Gio.DBusConnection.DBusConnection
getClientDbusConnection :: forall (m :: * -> *) o.
(MonadIO m, IsClient o) =>
o -> m DBusConnection
getClientDbusConnection o
obj = IO DBusConnection -> m DBusConnection
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO DBusConnection -> m DBusConnection)
-> IO DBusConnection -> m DBusConnection
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe DBusConnection) -> IO DBusConnection
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getClientDbusConnection" (IO (Maybe DBusConnection) -> IO DBusConnection)
-> IO (Maybe DBusConnection) -> IO DBusConnection
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr DBusConnection -> DBusConnection)
-> IO (Maybe DBusConnection)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"dbus-connection" ManagedPtr DBusConnection -> DBusConnection
Gio.DBusConnection.DBusConnection

-- | Construct a t'GValueConstruct' with valid value for the “@dbus-connection@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructClientDbusConnection :: (IsClient o, MIO.MonadIO m, Gio.DBusConnection.IsDBusConnection a) => a -> m (GValueConstruct o)
constructClientDbusConnection :: forall o (m :: * -> *) a.
(IsClient o, MonadIO m, IsDBusConnection a) =>
a -> m (GValueConstruct o)
constructClientDbusConnection a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"dbus-connection" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

#if defined(ENABLE_OVERLOADING)
data ClientDbusConnectionPropertyInfo
instance AttrInfo ClientDbusConnectionPropertyInfo where
    type AttrAllowedOps ClientDbusConnectionPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ClientDbusConnectionPropertyInfo = IsClient
    type AttrSetTypeConstraint ClientDbusConnectionPropertyInfo = Gio.DBusConnection.IsDBusConnection
    type AttrTransferTypeConstraint ClientDbusConnectionPropertyInfo = Gio.DBusConnection.IsDBusConnection
    type AttrTransferType ClientDbusConnectionPropertyInfo = Gio.DBusConnection.DBusConnection
    type AttrGetType ClientDbusConnectionPropertyInfo = Gio.DBusConnection.DBusConnection
    type AttrLabel ClientDbusConnectionPropertyInfo = "dbus-connection"
    type AttrOrigin ClientDbusConnectionPropertyInfo = Client
    attrGet = getClientDbusConnection
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Gio.DBusConnection.DBusConnection v
    attrConstruct = constructClientDbusConnection
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.dbusConnection"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#g:attr:dbusConnection"
        })
#endif

-- VVV Prop "dbus-name-owner"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@dbus-name-owner@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' client #dbusNameOwner
-- @
getClientDbusNameOwner :: (MonadIO m, IsClient o) => o -> m T.Text
getClientDbusNameOwner :: forall (m :: * -> *) o. (MonadIO m, IsClient o) => o -> m Text
getClientDbusNameOwner o
obj = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getClientDbusNameOwner" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"dbus-name-owner"

#if defined(ENABLE_OVERLOADING)
data ClientDbusNameOwnerPropertyInfo
instance AttrInfo ClientDbusNameOwnerPropertyInfo where
    type AttrAllowedOps ClientDbusNameOwnerPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ClientDbusNameOwnerPropertyInfo = IsClient
    type AttrSetTypeConstraint ClientDbusNameOwnerPropertyInfo = (~) ()
    type AttrTransferTypeConstraint ClientDbusNameOwnerPropertyInfo = (~) ()
    type AttrTransferType ClientDbusNameOwnerPropertyInfo = ()
    type AttrGetType ClientDbusNameOwnerPropertyInfo = T.Text
    type AttrLabel ClientDbusNameOwnerPropertyInfo = "dbus-name-owner"
    type AttrOrigin ClientDbusNameOwnerPropertyInfo = Client
    attrGet = getClientDbusNameOwner
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.dbusNameOwner"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#g:attr:dbusNameOwner"
        })
#endif

-- XXX Generation of property "devices" of object "Client" failed.
-- Not implemented: Don't know how to handle properties of type TPtrArray (TInterface (Name {namespace = "NM", name = "Device"}))
#if defined(ENABLE_OVERLOADING)
-- XXX Placeholder
data ClientDevicesPropertyInfo
instance AttrInfo ClientDevicesPropertyInfo where
    type AttrAllowedOps ClientDevicesPropertyInfo = '[]
    type AttrSetTypeConstraint ClientDevicesPropertyInfo = (~) ()
    type AttrTransferTypeConstraint ClientDevicesPropertyInfo = (~) ()
    type AttrTransferType ClientDevicesPropertyInfo = ()
    type AttrBaseTypeConstraint ClientDevicesPropertyInfo = (~) ()
    type AttrGetType ClientDevicesPropertyInfo = ()
    type AttrLabel ClientDevicesPropertyInfo = ""
    type AttrOrigin ClientDevicesPropertyInfo = Client
    attrGet = undefined
    attrSet = undefined
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer = undefined
#endif

-- XXX Generation of property "dns-configuration" of object "Client" failed.
-- Not implemented: Don't know how to handle properties of type TPtrArray (TInterface (Name {namespace = "NM", name = "DnsEntry"}))
#if defined(ENABLE_OVERLOADING)
-- XXX Placeholder
data ClientDnsConfigurationPropertyInfo
instance AttrInfo ClientDnsConfigurationPropertyInfo where
    type AttrAllowedOps ClientDnsConfigurationPropertyInfo = '[]
    type AttrSetTypeConstraint ClientDnsConfigurationPropertyInfo = (~) ()
    type AttrTransferTypeConstraint ClientDnsConfigurationPropertyInfo = (~) ()
    type AttrTransferType ClientDnsConfigurationPropertyInfo = ()
    type AttrBaseTypeConstraint ClientDnsConfigurationPropertyInfo = (~) ()
    type AttrGetType ClientDnsConfigurationPropertyInfo = ()
    type AttrLabel ClientDnsConfigurationPropertyInfo = ""
    type AttrOrigin ClientDnsConfigurationPropertyInfo = Client
    attrGet = undefined
    attrSet = undefined
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer = undefined
#endif

-- VVV Prop "dns-mode"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@dns-mode@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' client #dnsMode
-- @
getClientDnsMode :: (MonadIO m, IsClient o) => o -> m T.Text
getClientDnsMode :: forall (m :: * -> *) o. (MonadIO m, IsClient o) => o -> m Text
getClientDnsMode o
obj = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getClientDnsMode" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"dns-mode"

#if defined(ENABLE_OVERLOADING)
data ClientDnsModePropertyInfo
instance AttrInfo ClientDnsModePropertyInfo where
    type AttrAllowedOps ClientDnsModePropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ClientDnsModePropertyInfo = IsClient
    type AttrSetTypeConstraint ClientDnsModePropertyInfo = (~) ()
    type AttrTransferTypeConstraint ClientDnsModePropertyInfo = (~) ()
    type AttrTransferType ClientDnsModePropertyInfo = ()
    type AttrGetType ClientDnsModePropertyInfo = T.Text
    type AttrLabel ClientDnsModePropertyInfo = "dns-mode"
    type AttrOrigin ClientDnsModePropertyInfo = Client
    attrGet = getClientDnsMode
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.dnsMode"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#g:attr:dnsMode"
        })
#endif

-- VVV Prop "dns-rc-manager"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@dns-rc-manager@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' client #dnsRcManager
-- @
getClientDnsRcManager :: (MonadIO m, IsClient o) => o -> m T.Text
getClientDnsRcManager :: forall (m :: * -> *) o. (MonadIO m, IsClient o) => o -> m Text
getClientDnsRcManager o
obj = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getClientDnsRcManager" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"dns-rc-manager"

#if defined(ENABLE_OVERLOADING)
data ClientDnsRcManagerPropertyInfo
instance AttrInfo ClientDnsRcManagerPropertyInfo where
    type AttrAllowedOps ClientDnsRcManagerPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ClientDnsRcManagerPropertyInfo = IsClient
    type AttrSetTypeConstraint ClientDnsRcManagerPropertyInfo = (~) ()
    type AttrTransferTypeConstraint ClientDnsRcManagerPropertyInfo = (~) ()
    type AttrTransferType ClientDnsRcManagerPropertyInfo = ()
    type AttrGetType ClientDnsRcManagerPropertyInfo = T.Text
    type AttrLabel ClientDnsRcManagerPropertyInfo = "dns-rc-manager"
    type AttrOrigin ClientDnsRcManagerPropertyInfo = Client
    attrGet = getClientDnsRcManager
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.dnsRcManager"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#g:attr:dnsRcManager"
        })
#endif

-- VVV Prop "hostname"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@hostname@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' client #hostname
-- @
getClientHostname :: (MonadIO m, IsClient o) => o -> m (Maybe T.Text)
getClientHostname :: forall (m :: * -> *) o.
(MonadIO m, IsClient o) =>
o -> m (Maybe Text)
getClientHostname o
obj = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"hostname"

#if defined(ENABLE_OVERLOADING)
data ClientHostnamePropertyInfo
instance AttrInfo ClientHostnamePropertyInfo where
    type AttrAllowedOps ClientHostnamePropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ClientHostnamePropertyInfo = IsClient
    type AttrSetTypeConstraint ClientHostnamePropertyInfo = (~) ()
    type AttrTransferTypeConstraint ClientHostnamePropertyInfo = (~) ()
    type AttrTransferType ClientHostnamePropertyInfo = ()
    type AttrGetType ClientHostnamePropertyInfo = (Maybe T.Text)
    type AttrLabel ClientHostnamePropertyInfo = "hostname"
    type AttrOrigin ClientHostnamePropertyInfo = Client
    attrGet = getClientHostname
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.hostname"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#g:attr:hostname"
        })
#endif

-- VVV Prop "instance-flags"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@instance-flags@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' client #instanceFlags
-- @
getClientInstanceFlags :: (MonadIO m, IsClient o) => o -> m Word32
getClientInstanceFlags :: forall (m :: * -> *) o. (MonadIO m, IsClient o) => o -> m Word32
getClientInstanceFlags o
obj = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj String
"instance-flags"

-- | Set the value of the “@instance-flags@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' client [ #instanceFlags 'Data.GI.Base.Attributes.:=' value ]
-- @
setClientInstanceFlags :: (MonadIO m, IsClient o) => o -> Word32 -> m ()
setClientInstanceFlags :: forall (m :: * -> *) o.
(MonadIO m, IsClient o) =>
o -> Word32 -> m ()
setClientInstanceFlags o
obj Word32
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Word32 -> IO ()
forall a. GObject a => a -> String -> Word32 -> IO ()
B.Properties.setObjectPropertyUInt32 o
obj String
"instance-flags" Word32
val

-- | Construct a t'GValueConstruct' with valid value for the “@instance-flags@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructClientInstanceFlags :: (IsClient o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructClientInstanceFlags :: forall o (m :: * -> *).
(IsClient o, MonadIO m) =>
Word32 -> m (GValueConstruct o)
constructClientInstanceFlags Word32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Word32 -> IO (GValueConstruct o)
forall o. String -> Word32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt32 String
"instance-flags" Word32
val

#if defined(ENABLE_OVERLOADING)
data ClientInstanceFlagsPropertyInfo
instance AttrInfo ClientInstanceFlagsPropertyInfo where
    type AttrAllowedOps ClientInstanceFlagsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ClientInstanceFlagsPropertyInfo = IsClient
    type AttrSetTypeConstraint ClientInstanceFlagsPropertyInfo = (~) Word32
    type AttrTransferTypeConstraint ClientInstanceFlagsPropertyInfo = (~) Word32
    type AttrTransferType ClientInstanceFlagsPropertyInfo = Word32
    type AttrGetType ClientInstanceFlagsPropertyInfo = Word32
    type AttrLabel ClientInstanceFlagsPropertyInfo = "instance-flags"
    type AttrOrigin ClientInstanceFlagsPropertyInfo = Client
    attrGet = getClientInstanceFlags
    attrSet = setClientInstanceFlags
    attrTransfer _ v = do
        return v
    attrConstruct = constructClientInstanceFlags
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.instanceFlags"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#g:attr:instanceFlags"
        })
#endif

-- VVV Prop "metered"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@metered@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' client #metered
-- @
getClientMetered :: (MonadIO m, IsClient o) => o -> m Word32
getClientMetered :: forall (m :: * -> *) o. (MonadIO m, IsClient o) => o -> m Word32
getClientMetered o
obj = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj String
"metered"

#if defined(ENABLE_OVERLOADING)
data ClientMeteredPropertyInfo
instance AttrInfo ClientMeteredPropertyInfo where
    type AttrAllowedOps ClientMeteredPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint ClientMeteredPropertyInfo = IsClient
    type AttrSetTypeConstraint ClientMeteredPropertyInfo = (~) ()
    type AttrTransferTypeConstraint ClientMeteredPropertyInfo = (~) ()
    type AttrTransferType ClientMeteredPropertyInfo = ()
    type AttrGetType ClientMeteredPropertyInfo = Word32
    type AttrLabel ClientMeteredPropertyInfo = "metered"
    type AttrOrigin ClientMeteredPropertyInfo = Client
    attrGet = getClientMetered
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.metered"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#g:attr:metered"
        })
#endif

-- VVV Prop "networking-enabled"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@networking-enabled@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' client #networkingEnabled
-- @
getClientNetworkingEnabled :: (MonadIO m, IsClient o) => o -> m Bool
getClientNetworkingEnabled :: forall (m :: * -> *) o. (MonadIO m, IsClient o) => o -> m Bool
getClientNetworkingEnabled o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"networking-enabled"

-- | Set the value of the “@networking-enabled@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' client [ #networkingEnabled 'Data.GI.Base.Attributes.:=' value ]
-- @
setClientNetworkingEnabled :: (MonadIO m, IsClient o) => o -> Bool -> m ()
setClientNetworkingEnabled :: forall (m :: * -> *) o.
(MonadIO m, IsClient o) =>
o -> Bool -> m ()
setClientNetworkingEnabled o
obj Bool
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"networking-enabled" Bool
val

-- | Construct a t'GValueConstruct' with valid value for the “@networking-enabled@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructClientNetworkingEnabled :: (IsClient o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructClientNetworkingEnabled :: forall o (m :: * -> *).
(IsClient o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructClientNetworkingEnabled Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"networking-enabled" Bool
val

#if defined(ENABLE_OVERLOADING)
data ClientNetworkingEnabledPropertyInfo
instance AttrInfo ClientNetworkingEnabledPropertyInfo where
    type AttrAllowedOps ClientNetworkingEnabledPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ClientNetworkingEnabledPropertyInfo = IsClient
    type AttrSetTypeConstraint ClientNetworkingEnabledPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint ClientNetworkingEnabledPropertyInfo = (~) Bool
    type AttrTransferType ClientNetworkingEnabledPropertyInfo = Bool
    type AttrGetType ClientNetworkingEnabledPropertyInfo = Bool
    type AttrLabel ClientNetworkingEnabledPropertyInfo = "networking-enabled"
    type AttrOrigin ClientNetworkingEnabledPropertyInfo = Client
    attrGet = getClientNetworkingEnabled
    attrSet = setClientNetworkingEnabled
    attrTransfer _ v = do
        return v
    attrConstruct = constructClientNetworkingEnabled
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.networkingEnabled"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#g:attr:networkingEnabled"
        })
#endif

-- VVV Prop "nm-running"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@nm-running@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' client #nmRunning
-- @
getClientNmRunning :: (MonadIO m, IsClient o) => o -> m Bool
getClientNmRunning :: forall (m :: * -> *) o. (MonadIO m, IsClient o) => o -> m Bool
getClientNmRunning o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"nm-running"

#if defined(ENABLE_OVERLOADING)
data ClientNmRunningPropertyInfo
instance AttrInfo ClientNmRunningPropertyInfo where
    type AttrAllowedOps ClientNmRunningPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint ClientNmRunningPropertyInfo = IsClient
    type AttrSetTypeConstraint ClientNmRunningPropertyInfo = (~) ()
    type AttrTransferTypeConstraint ClientNmRunningPropertyInfo = (~) ()
    type AttrTransferType ClientNmRunningPropertyInfo = ()
    type AttrGetType ClientNmRunningPropertyInfo = Bool
    type AttrLabel ClientNmRunningPropertyInfo = "nm-running"
    type AttrOrigin ClientNmRunningPropertyInfo = Client
    attrGet = getClientNmRunning
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.nmRunning"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#g:attr:nmRunning"
        })
#endif

-- VVV Prop "permissions-state"
   -- Type: TInterface (Name {namespace = "NM", name = "Ternary"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@permissions-state@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' client #permissionsState
-- @
getClientPermissionsState :: (MonadIO m, IsClient o) => o -> m NM.Enums.Ternary
getClientPermissionsState :: forall (m :: * -> *) o. (MonadIO m, IsClient o) => o -> m Ternary
getClientPermissionsState o
obj = IO Ternary -> m Ternary
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Ternary -> m Ternary) -> IO Ternary -> m Ternary
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Ternary
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"permissions-state"

#if defined(ENABLE_OVERLOADING)
data ClientPermissionsStatePropertyInfo
instance AttrInfo ClientPermissionsStatePropertyInfo where
    type AttrAllowedOps ClientPermissionsStatePropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint ClientPermissionsStatePropertyInfo = IsClient
    type AttrSetTypeConstraint ClientPermissionsStatePropertyInfo = (~) ()
    type AttrTransferTypeConstraint ClientPermissionsStatePropertyInfo = (~) ()
    type AttrTransferType ClientPermissionsStatePropertyInfo = ()
    type AttrGetType ClientPermissionsStatePropertyInfo = NM.Enums.Ternary
    type AttrLabel ClientPermissionsStatePropertyInfo = "permissions-state"
    type AttrOrigin ClientPermissionsStatePropertyInfo = Client
    attrGet = getClientPermissionsState
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.permissionsState"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#g:attr:permissionsState"
        })
#endif

-- VVV Prop "primary-connection"
   -- Type: TInterface (Name {namespace = "NM", name = "ActiveConnection"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@primary-connection@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' client #primaryConnection
-- @
getClientPrimaryConnection :: (MonadIO m, IsClient o) => o -> m NM.ActiveConnection.ActiveConnection
getClientPrimaryConnection :: forall (m :: * -> *) o.
(MonadIO m, IsClient o) =>
o -> m ActiveConnection
getClientPrimaryConnection o
obj = IO ActiveConnection -> m ActiveConnection
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO ActiveConnection -> m ActiveConnection)
-> IO ActiveConnection -> m ActiveConnection
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe ActiveConnection) -> IO ActiveConnection
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getClientPrimaryConnection" (IO (Maybe ActiveConnection) -> IO ActiveConnection)
-> IO (Maybe ActiveConnection) -> IO ActiveConnection
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr ActiveConnection -> ActiveConnection)
-> IO (Maybe ActiveConnection)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"primary-connection" ManagedPtr ActiveConnection -> ActiveConnection
NM.ActiveConnection.ActiveConnection

#if defined(ENABLE_OVERLOADING)
data ClientPrimaryConnectionPropertyInfo
instance AttrInfo ClientPrimaryConnectionPropertyInfo where
    type AttrAllowedOps ClientPrimaryConnectionPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ClientPrimaryConnectionPropertyInfo = IsClient
    type AttrSetTypeConstraint ClientPrimaryConnectionPropertyInfo = (~) ()
    type AttrTransferTypeConstraint ClientPrimaryConnectionPropertyInfo = (~) ()
    type AttrTransferType ClientPrimaryConnectionPropertyInfo = ()
    type AttrGetType ClientPrimaryConnectionPropertyInfo = NM.ActiveConnection.ActiveConnection
    type AttrLabel ClientPrimaryConnectionPropertyInfo = "primary-connection"
    type AttrOrigin ClientPrimaryConnectionPropertyInfo = Client
    attrGet = getClientPrimaryConnection
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.primaryConnection"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#g:attr:primaryConnection"
        })
#endif

-- VVV Prop "radio-flags"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@radio-flags@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' client #radioFlags
-- @
getClientRadioFlags :: (MonadIO m, IsClient o) => o -> m Word32
getClientRadioFlags :: forall (m :: * -> *) o. (MonadIO m, IsClient o) => o -> m Word32
getClientRadioFlags o
obj = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj String
"radio-flags"

#if defined(ENABLE_OVERLOADING)
data ClientRadioFlagsPropertyInfo
instance AttrInfo ClientRadioFlagsPropertyInfo where
    type AttrAllowedOps ClientRadioFlagsPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint ClientRadioFlagsPropertyInfo = IsClient
    type AttrSetTypeConstraint ClientRadioFlagsPropertyInfo = (~) ()
    type AttrTransferTypeConstraint ClientRadioFlagsPropertyInfo = (~) ()
    type AttrTransferType ClientRadioFlagsPropertyInfo = ()
    type AttrGetType ClientRadioFlagsPropertyInfo = Word32
    type AttrLabel ClientRadioFlagsPropertyInfo = "radio-flags"
    type AttrOrigin ClientRadioFlagsPropertyInfo = Client
    attrGet = getClientRadioFlags
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.radioFlags"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#g:attr:radioFlags"
        })
#endif

-- VVV Prop "startup"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@startup@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' client #startup
-- @
getClientStartup :: (MonadIO m, IsClient o) => o -> m Bool
getClientStartup :: forall (m :: * -> *) o. (MonadIO m, IsClient o) => o -> m Bool
getClientStartup o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"startup"

#if defined(ENABLE_OVERLOADING)
data ClientStartupPropertyInfo
instance AttrInfo ClientStartupPropertyInfo where
    type AttrAllowedOps ClientStartupPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint ClientStartupPropertyInfo = IsClient
    type AttrSetTypeConstraint ClientStartupPropertyInfo = (~) ()
    type AttrTransferTypeConstraint ClientStartupPropertyInfo = (~) ()
    type AttrTransferType ClientStartupPropertyInfo = ()
    type AttrGetType ClientStartupPropertyInfo = Bool
    type AttrLabel ClientStartupPropertyInfo = "startup"
    type AttrOrigin ClientStartupPropertyInfo = Client
    attrGet = getClientStartup
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.startup"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#g:attr:startup"
        })
#endif

-- VVV Prop "state"
   -- Type: TInterface (Name {namespace = "NM", name = "State"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@state@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' client #state
-- @
getClientState :: (MonadIO m, IsClient o) => o -> m NM.Enums.State
getClientState :: forall (m :: * -> *) o. (MonadIO m, IsClient o) => o -> m State
getClientState o
obj = IO State -> m State
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO State -> m State) -> IO State -> m State
forall a b. (a -> b) -> a -> b
$ o -> String -> IO State
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"state"

#if defined(ENABLE_OVERLOADING)
data ClientStatePropertyInfo
instance AttrInfo ClientStatePropertyInfo where
    type AttrAllowedOps ClientStatePropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint ClientStatePropertyInfo = IsClient
    type AttrSetTypeConstraint ClientStatePropertyInfo = (~) ()
    type AttrTransferTypeConstraint ClientStatePropertyInfo = (~) ()
    type AttrTransferType ClientStatePropertyInfo = ()
    type AttrGetType ClientStatePropertyInfo = NM.Enums.State
    type AttrLabel ClientStatePropertyInfo = "state"
    type AttrOrigin ClientStatePropertyInfo = Client
    attrGet = getClientState
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.state"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#g:attr:state"
        })
#endif

-- VVV Prop "version"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@version@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' client #version
-- @
getClientVersion :: (MonadIO m, IsClient o) => o -> m T.Text
getClientVersion :: forall (m :: * -> *) o. (MonadIO m, IsClient o) => o -> m Text
getClientVersion o
obj = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getClientVersion" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"version"

#if defined(ENABLE_OVERLOADING)
data ClientVersionPropertyInfo
instance AttrInfo ClientVersionPropertyInfo where
    type AttrAllowedOps ClientVersionPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ClientVersionPropertyInfo = IsClient
    type AttrSetTypeConstraint ClientVersionPropertyInfo = (~) ()
    type AttrTransferTypeConstraint ClientVersionPropertyInfo = (~) ()
    type AttrTransferType ClientVersionPropertyInfo = ()
    type AttrGetType ClientVersionPropertyInfo = T.Text
    type AttrLabel ClientVersionPropertyInfo = "version"
    type AttrOrigin ClientVersionPropertyInfo = Client
    attrGet = getClientVersion
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.version"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#g:attr:version"
        })
#endif

-- XXX Generation of property "version-info" of object "Client" failed.
-- Not implemented: Don't know how to handle properties of type TGArray (TBasicType TUInt32)
#if defined(ENABLE_OVERLOADING)
-- XXX Placeholder
data ClientVersionInfoPropertyInfo
instance AttrInfo ClientVersionInfoPropertyInfo where
    type AttrAllowedOps ClientVersionInfoPropertyInfo = '[]
    type AttrSetTypeConstraint ClientVersionInfoPropertyInfo = (~) ()
    type AttrTransferTypeConstraint ClientVersionInfoPropertyInfo = (~) ()
    type AttrTransferType ClientVersionInfoPropertyInfo = ()
    type AttrBaseTypeConstraint ClientVersionInfoPropertyInfo = (~) ()
    type AttrGetType ClientVersionInfoPropertyInfo = ()
    type AttrLabel ClientVersionInfoPropertyInfo = ""
    type AttrOrigin ClientVersionInfoPropertyInfo = Client
    attrGet = undefined
    attrSet = undefined
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer = undefined
#endif

-- VVV Prop "wimax-enabled"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@wimax-enabled@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' client #wimaxEnabled
-- @
getClientWimaxEnabled :: (MonadIO m, IsClient o) => o -> m Bool
getClientWimaxEnabled :: forall (m :: * -> *) o. (MonadIO m, IsClient o) => o -> m Bool
getClientWimaxEnabled o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"wimax-enabled"

-- | Set the value of the “@wimax-enabled@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' client [ #wimaxEnabled 'Data.GI.Base.Attributes.:=' value ]
-- @
setClientWimaxEnabled :: (MonadIO m, IsClient o) => o -> Bool -> m ()
setClientWimaxEnabled :: forall (m :: * -> *) o.
(MonadIO m, IsClient o) =>
o -> Bool -> m ()
setClientWimaxEnabled o
obj Bool
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"wimax-enabled" Bool
val

-- | Construct a t'GValueConstruct' with valid value for the “@wimax-enabled@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructClientWimaxEnabled :: (IsClient o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructClientWimaxEnabled :: forall o (m :: * -> *).
(IsClient o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructClientWimaxEnabled Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"wimax-enabled" Bool
val

#if defined(ENABLE_OVERLOADING)
data ClientWimaxEnabledPropertyInfo
instance AttrInfo ClientWimaxEnabledPropertyInfo where
    type AttrAllowedOps ClientWimaxEnabledPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ClientWimaxEnabledPropertyInfo = IsClient
    type AttrSetTypeConstraint ClientWimaxEnabledPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint ClientWimaxEnabledPropertyInfo = (~) Bool
    type AttrTransferType ClientWimaxEnabledPropertyInfo = Bool
    type AttrGetType ClientWimaxEnabledPropertyInfo = Bool
    type AttrLabel ClientWimaxEnabledPropertyInfo = "wimax-enabled"
    type AttrOrigin ClientWimaxEnabledPropertyInfo = Client
    attrGet = getClientWimaxEnabled
    attrSet = setClientWimaxEnabled
    attrTransfer _ v = do
        return v
    attrConstruct = constructClientWimaxEnabled
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.wimaxEnabled"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#g:attr:wimaxEnabled"
        })
#endif

-- VVV Prop "wimax-hardware-enabled"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@wimax-hardware-enabled@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' client #wimaxHardwareEnabled
-- @
getClientWimaxHardwareEnabled :: (MonadIO m, IsClient o) => o -> m Bool
getClientWimaxHardwareEnabled :: forall (m :: * -> *) o. (MonadIO m, IsClient o) => o -> m Bool
getClientWimaxHardwareEnabled o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"wimax-hardware-enabled"

#if defined(ENABLE_OVERLOADING)
data ClientWimaxHardwareEnabledPropertyInfo
instance AttrInfo ClientWimaxHardwareEnabledPropertyInfo where
    type AttrAllowedOps ClientWimaxHardwareEnabledPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint ClientWimaxHardwareEnabledPropertyInfo = IsClient
    type AttrSetTypeConstraint ClientWimaxHardwareEnabledPropertyInfo = (~) ()
    type AttrTransferTypeConstraint ClientWimaxHardwareEnabledPropertyInfo = (~) ()
    type AttrTransferType ClientWimaxHardwareEnabledPropertyInfo = ()
    type AttrGetType ClientWimaxHardwareEnabledPropertyInfo = Bool
    type AttrLabel ClientWimaxHardwareEnabledPropertyInfo = "wimax-hardware-enabled"
    type AttrOrigin ClientWimaxHardwareEnabledPropertyInfo = Client
    attrGet = getClientWimaxHardwareEnabled
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.wimaxHardwareEnabled"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#g:attr:wimaxHardwareEnabled"
        })
#endif

-- VVV Prop "wireless-enabled"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@wireless-enabled@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' client #wirelessEnabled
-- @
getClientWirelessEnabled :: (MonadIO m, IsClient o) => o -> m Bool
getClientWirelessEnabled :: forall (m :: * -> *) o. (MonadIO m, IsClient o) => o -> m Bool
getClientWirelessEnabled o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"wireless-enabled"

-- | Set the value of the “@wireless-enabled@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' client [ #wirelessEnabled 'Data.GI.Base.Attributes.:=' value ]
-- @
setClientWirelessEnabled :: (MonadIO m, IsClient o) => o -> Bool -> m ()
setClientWirelessEnabled :: forall (m :: * -> *) o.
(MonadIO m, IsClient o) =>
o -> Bool -> m ()
setClientWirelessEnabled o
obj Bool
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"wireless-enabled" Bool
val

-- | Construct a t'GValueConstruct' with valid value for the “@wireless-enabled@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructClientWirelessEnabled :: (IsClient o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructClientWirelessEnabled :: forall o (m :: * -> *).
(IsClient o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructClientWirelessEnabled Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"wireless-enabled" Bool
val

#if defined(ENABLE_OVERLOADING)
data ClientWirelessEnabledPropertyInfo
instance AttrInfo ClientWirelessEnabledPropertyInfo where
    type AttrAllowedOps ClientWirelessEnabledPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ClientWirelessEnabledPropertyInfo = IsClient
    type AttrSetTypeConstraint ClientWirelessEnabledPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint ClientWirelessEnabledPropertyInfo = (~) Bool
    type AttrTransferType ClientWirelessEnabledPropertyInfo = Bool
    type AttrGetType ClientWirelessEnabledPropertyInfo = Bool
    type AttrLabel ClientWirelessEnabledPropertyInfo = "wireless-enabled"
    type AttrOrigin ClientWirelessEnabledPropertyInfo = Client
    attrGet = getClientWirelessEnabled
    attrSet = setClientWirelessEnabled
    attrTransfer _ v = do
        return v
    attrConstruct = constructClientWirelessEnabled
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.wirelessEnabled"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#g:attr:wirelessEnabled"
        })
#endif

-- VVV Prop "wireless-hardware-enabled"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@wireless-hardware-enabled@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' client #wirelessHardwareEnabled
-- @
getClientWirelessHardwareEnabled :: (MonadIO m, IsClient o) => o -> m Bool
getClientWirelessHardwareEnabled :: forall (m :: * -> *) o. (MonadIO m, IsClient o) => o -> m Bool
getClientWirelessHardwareEnabled o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"wireless-hardware-enabled"

#if defined(ENABLE_OVERLOADING)
data ClientWirelessHardwareEnabledPropertyInfo
instance AttrInfo ClientWirelessHardwareEnabledPropertyInfo where
    type AttrAllowedOps ClientWirelessHardwareEnabledPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint ClientWirelessHardwareEnabledPropertyInfo = IsClient
    type AttrSetTypeConstraint ClientWirelessHardwareEnabledPropertyInfo = (~) ()
    type AttrTransferTypeConstraint ClientWirelessHardwareEnabledPropertyInfo = (~) ()
    type AttrTransferType ClientWirelessHardwareEnabledPropertyInfo = ()
    type AttrGetType ClientWirelessHardwareEnabledPropertyInfo = Bool
    type AttrLabel ClientWirelessHardwareEnabledPropertyInfo = "wireless-hardware-enabled"
    type AttrOrigin ClientWirelessHardwareEnabledPropertyInfo = Client
    attrGet = getClientWirelessHardwareEnabled
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.wirelessHardwareEnabled"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#g:attr:wirelessHardwareEnabled"
        })
#endif

-- VVV Prop "wwan-enabled"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@wwan-enabled@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' client #wwanEnabled
-- @
getClientWwanEnabled :: (MonadIO m, IsClient o) => o -> m Bool
getClientWwanEnabled :: forall (m :: * -> *) o. (MonadIO m, IsClient o) => o -> m Bool
getClientWwanEnabled o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"wwan-enabled"

-- | Set the value of the “@wwan-enabled@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' client [ #wwanEnabled 'Data.GI.Base.Attributes.:=' value ]
-- @
setClientWwanEnabled :: (MonadIO m, IsClient o) => o -> Bool -> m ()
setClientWwanEnabled :: forall (m :: * -> *) o.
(MonadIO m, IsClient o) =>
o -> Bool -> m ()
setClientWwanEnabled o
obj Bool
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"wwan-enabled" Bool
val

-- | Construct a t'GValueConstruct' with valid value for the “@wwan-enabled@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructClientWwanEnabled :: (IsClient o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructClientWwanEnabled :: forall o (m :: * -> *).
(IsClient o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructClientWwanEnabled Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"wwan-enabled" Bool
val

#if defined(ENABLE_OVERLOADING)
data ClientWwanEnabledPropertyInfo
instance AttrInfo ClientWwanEnabledPropertyInfo where
    type AttrAllowedOps ClientWwanEnabledPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ClientWwanEnabledPropertyInfo = IsClient
    type AttrSetTypeConstraint ClientWwanEnabledPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint ClientWwanEnabledPropertyInfo = (~) Bool
    type AttrTransferType ClientWwanEnabledPropertyInfo = Bool
    type AttrGetType ClientWwanEnabledPropertyInfo = Bool
    type AttrLabel ClientWwanEnabledPropertyInfo = "wwan-enabled"
    type AttrOrigin ClientWwanEnabledPropertyInfo = Client
    attrGet = getClientWwanEnabled
    attrSet = setClientWwanEnabled
    attrTransfer _ v = do
        return v
    attrConstruct = constructClientWwanEnabled
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.wwanEnabled"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#g:attr:wwanEnabled"
        })
#endif

-- VVV Prop "wwan-hardware-enabled"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@wwan-hardware-enabled@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' client #wwanHardwareEnabled
-- @
getClientWwanHardwareEnabled :: (MonadIO m, IsClient o) => o -> m Bool
getClientWwanHardwareEnabled :: forall (m :: * -> *) o. (MonadIO m, IsClient o) => o -> m Bool
getClientWwanHardwareEnabled o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"wwan-hardware-enabled"

#if defined(ENABLE_OVERLOADING)
data ClientWwanHardwareEnabledPropertyInfo
instance AttrInfo ClientWwanHardwareEnabledPropertyInfo where
    type AttrAllowedOps ClientWwanHardwareEnabledPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint ClientWwanHardwareEnabledPropertyInfo = IsClient
    type AttrSetTypeConstraint ClientWwanHardwareEnabledPropertyInfo = (~) ()
    type AttrTransferTypeConstraint ClientWwanHardwareEnabledPropertyInfo = (~) ()
    type AttrTransferType ClientWwanHardwareEnabledPropertyInfo = ()
    type AttrGetType ClientWwanHardwareEnabledPropertyInfo = Bool
    type AttrLabel ClientWwanHardwareEnabledPropertyInfo = "wwan-hardware-enabled"
    type AttrOrigin ClientWwanHardwareEnabledPropertyInfo = Client
    attrGet = getClientWwanHardwareEnabled
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.wwanHardwareEnabled"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#g:attr:wwanHardwareEnabled"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Client
type instance O.AttributeList Client = ClientAttributeList
type ClientAttributeList = ('[ '("activatingConnection", ClientActivatingConnectionPropertyInfo), '("activeConnections", ClientActiveConnectionsPropertyInfo), '("allDevices", ClientAllDevicesPropertyInfo), '("canModify", ClientCanModifyPropertyInfo), '("capabilities", ClientCapabilitiesPropertyInfo), '("checkpoints", ClientCheckpointsPropertyInfo), '("connections", ClientConnectionsPropertyInfo), '("connectivity", ClientConnectivityPropertyInfo), '("connectivityCheckAvailable", ClientConnectivityCheckAvailablePropertyInfo), '("connectivityCheckEnabled", ClientConnectivityCheckEnabledPropertyInfo), '("connectivityCheckUri", ClientConnectivityCheckUriPropertyInfo), '("dbusConnection", ClientDbusConnectionPropertyInfo), '("dbusNameOwner", ClientDbusNameOwnerPropertyInfo), '("devices", ClientDevicesPropertyInfo), '("dnsConfiguration", ClientDnsConfigurationPropertyInfo), '("dnsMode", ClientDnsModePropertyInfo), '("dnsRcManager", ClientDnsRcManagerPropertyInfo), '("hostname", ClientHostnamePropertyInfo), '("instanceFlags", ClientInstanceFlagsPropertyInfo), '("metered", ClientMeteredPropertyInfo), '("networkingEnabled", ClientNetworkingEnabledPropertyInfo), '("nmRunning", ClientNmRunningPropertyInfo), '("permissionsState", ClientPermissionsStatePropertyInfo), '("primaryConnection", ClientPrimaryConnectionPropertyInfo), '("radioFlags", ClientRadioFlagsPropertyInfo), '("startup", ClientStartupPropertyInfo), '("state", ClientStatePropertyInfo), '("version", ClientVersionPropertyInfo), '("versionInfo", ClientVersionInfoPropertyInfo), '("wimaxEnabled", ClientWimaxEnabledPropertyInfo), '("wimaxHardwareEnabled", ClientWimaxHardwareEnabledPropertyInfo), '("wirelessEnabled", ClientWirelessEnabledPropertyInfo), '("wirelessHardwareEnabled", ClientWirelessHardwareEnabledPropertyInfo), '("wwanEnabled", ClientWwanEnabledPropertyInfo), '("wwanHardwareEnabled", ClientWwanHardwareEnabledPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
clientActivatingConnection :: AttrLabelProxy "activatingConnection"
clientActivatingConnection = AttrLabelProxy

clientActiveConnections :: AttrLabelProxy "activeConnections"
clientActiveConnections = AttrLabelProxy

clientAllDevices :: AttrLabelProxy "allDevices"
clientAllDevices = AttrLabelProxy

clientCanModify :: AttrLabelProxy "canModify"
clientCanModify = AttrLabelProxy

clientCapabilities :: AttrLabelProxy "capabilities"
clientCapabilities = AttrLabelProxy

clientCheckpoints :: AttrLabelProxy "checkpoints"
clientCheckpoints = AttrLabelProxy

clientConnections :: AttrLabelProxy "connections"
clientConnections = AttrLabelProxy

clientConnectivity :: AttrLabelProxy "connectivity"
clientConnectivity = AttrLabelProxy

clientConnectivityCheckAvailable :: AttrLabelProxy "connectivityCheckAvailable"
clientConnectivityCheckAvailable = AttrLabelProxy

clientConnectivityCheckEnabled :: AttrLabelProxy "connectivityCheckEnabled"
clientConnectivityCheckEnabled = AttrLabelProxy

clientConnectivityCheckUri :: AttrLabelProxy "connectivityCheckUri"
clientConnectivityCheckUri = AttrLabelProxy

clientDbusConnection :: AttrLabelProxy "dbusConnection"
clientDbusConnection = AttrLabelProxy

clientDbusNameOwner :: AttrLabelProxy "dbusNameOwner"
clientDbusNameOwner = AttrLabelProxy

clientDevices :: AttrLabelProxy "devices"
clientDevices = AttrLabelProxy

clientDnsConfiguration :: AttrLabelProxy "dnsConfiguration"
clientDnsConfiguration = AttrLabelProxy

clientDnsMode :: AttrLabelProxy "dnsMode"
clientDnsMode = AttrLabelProxy

clientDnsRcManager :: AttrLabelProxy "dnsRcManager"
clientDnsRcManager = AttrLabelProxy

clientHostname :: AttrLabelProxy "hostname"
clientHostname = AttrLabelProxy

clientInstanceFlags :: AttrLabelProxy "instanceFlags"
clientInstanceFlags = AttrLabelProxy

clientMetered :: AttrLabelProxy "metered"
clientMetered = AttrLabelProxy

clientNetworkingEnabled :: AttrLabelProxy "networkingEnabled"
clientNetworkingEnabled = AttrLabelProxy

clientNmRunning :: AttrLabelProxy "nmRunning"
clientNmRunning = AttrLabelProxy

clientPermissionsState :: AttrLabelProxy "permissionsState"
clientPermissionsState = AttrLabelProxy

clientPrimaryConnection :: AttrLabelProxy "primaryConnection"
clientPrimaryConnection = AttrLabelProxy

clientRadioFlags :: AttrLabelProxy "radioFlags"
clientRadioFlags = AttrLabelProxy

clientStartup :: AttrLabelProxy "startup"
clientStartup = AttrLabelProxy

clientState :: AttrLabelProxy "state"
clientState = AttrLabelProxy

clientVersion :: AttrLabelProxy "version"
clientVersion = AttrLabelProxy

clientVersionInfo :: AttrLabelProxy "versionInfo"
clientVersionInfo = AttrLabelProxy

clientWimaxEnabled :: AttrLabelProxy "wimaxEnabled"
clientWimaxEnabled = AttrLabelProxy

clientWimaxHardwareEnabled :: AttrLabelProxy "wimaxHardwareEnabled"
clientWimaxHardwareEnabled = AttrLabelProxy

clientWirelessEnabled :: AttrLabelProxy "wirelessEnabled"
clientWirelessEnabled = AttrLabelProxy

clientWirelessHardwareEnabled :: AttrLabelProxy "wirelessHardwareEnabled"
clientWirelessHardwareEnabled = AttrLabelProxy

clientWwanEnabled :: AttrLabelProxy "wwanEnabled"
clientWwanEnabled = AttrLabelProxy

clientWwanHardwareEnabled :: AttrLabelProxy "wwanHardwareEnabled"
clientWwanHardwareEnabled = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Client = ClientSignalList
type ClientSignalList = ('[ '("activeConnectionAdded", ClientActiveConnectionAddedSignalInfo), '("activeConnectionRemoved", ClientActiveConnectionRemovedSignalInfo), '("anyDeviceAdded", ClientAnyDeviceAddedSignalInfo), '("anyDeviceRemoved", ClientAnyDeviceRemovedSignalInfo), '("connectionAdded", ClientConnectionAddedSignalInfo), '("connectionRemoved", ClientConnectionRemovedSignalInfo), '("deviceAdded", ClientDeviceAddedSignalInfo), '("deviceRemoved", ClientDeviceRemovedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("permissionChanged", ClientPermissionChangedSignalInfo)] :: [(Symbol, DK.Type)])

#endif

-- method Client::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "NM" , name = "Client" })
-- throws : True
-- Skip return : False

foreign import ccall "nm_client_new" nm_client_new :: 
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Client)

-- | Creates a new t'GI.NM.Objects.Client.Client' synchronously.
-- 
-- Note that this will block until a NMClient instance is fully initialized.
-- This does nothing beside calling @/g_initable_new()/@. You are free to call
-- @/g_initable_new()/@ or @/g_object_new()/@\/'GI.Gio.Interfaces.Initable.initableInit' directly for more
-- control, to set GObject properties or get access to the NMClient instance
-- while it is still initializing.
-- 
-- Using the synchronous initialization creates an t'GI.NM.Objects.Client.Client' instance
-- that uses an internal t'GI.GLib.Structs.MainContext.MainContext'. This context is invisible to the
-- user. This introduces an additional overhead that is payed not
-- only during object initialization, but for the entire lifetime of
-- this object.
-- Also, due to this internal t'GI.GLib.Structs.MainContext.MainContext', the events are no longer
-- in sync with other messages from t'GI.Gio.Objects.DBusConnection.DBusConnection' (but all events
-- of the NMClient will themselves still be ordered).
-- For a serious program, you should therefore avoid these problems by
-- using 'GI.Gio.Interfaces.AsyncInitable.asyncInitableInitAsync' or 'GI.NM.Objects.Client.clientNewAsync' instead.
-- The sync initialization is still useful for simple scripts or interactive
-- testing for example via pygobject.
-- 
-- Creating an t'GI.NM.Objects.Client.Client' instance can only fail for two reasons. First, if you didn\'t
-- provide a 'GI.NM.Constants.CLIENT_DBUS_CONNECTION' and the call to 'GI.Gio.Functions.busGet'
-- fails. You can avoid that by using @/g_initable_new()/@ directly and
-- set a D-Bus connection.
-- Second, if you cancelled the creation. If you do that, then note
-- that after the failure there might still be idle actions pending
-- which keep 'GI.NM.Objects.Client.clientGetMainContext' alive. That means,
-- in that case you must continue iterating the context to avoid
-- leaks. See 'GI.NM.Objects.Client.clientGetContextBusyWatcher'.
-- 
-- Creating an t'GI.NM.Objects.Client.Client' instance when NetworkManager is not running
-- does not cause a failure.
clientNew ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.Cancellable.IsCancellable a) =>
    Maybe (a)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> m Client
    -- ^ __Returns:__ a new t'GI.NM.Objects.Client.Client' or NULL on an error /(Can throw 'Data.GI.Base.GError.GError')/
clientNew :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCancellable a) =>
Maybe a -> m Client
clientNew Maybe a
cancellable = IO Client -> m Client
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Client -> m Client) -> IO Client -> m Client
forall a b. (a -> b) -> a -> b
$ do
    Ptr Cancellable
maybeCancellable <- case Maybe a
cancellable of
        Maybe a
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just a
jCancellable -> do
            Ptr Cancellable
jCancellable' <- a -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO Client -> IO () -> IO Client
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Client
result <- (Ptr (Ptr GError) -> IO (Ptr Client)) -> IO (Ptr Client)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Client)) -> IO (Ptr Client))
-> (Ptr (Ptr GError) -> IO (Ptr Client)) -> IO (Ptr Client)
forall a b. (a -> b) -> a -> b
$ Ptr Cancellable -> Ptr (Ptr GError) -> IO (Ptr Client)
nm_client_new Ptr Cancellable
maybeCancellable
        Text -> Ptr Client -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"clientNew" Ptr Client
result
        Client
result' <- ((ManagedPtr Client -> Client) -> Ptr Client -> IO Client
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Client -> Client
Client) Ptr Client
result
        Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
cancellable a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Client -> IO Client
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Client
result'
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method Client::new_finish
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAsyncResult" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "NM" , name = "Client" })
-- throws : True
-- Skip return : False

foreign import ccall "nm_client_new_finish" nm_client_new_finish :: 
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Client)

-- | Gets the result of an 'GI.NM.Objects.Client.clientNewAsync' call.
clientNewFinish ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.AsyncResult.IsAsyncResult a) =>
    a
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m Client
    -- ^ __Returns:__ a new t'GI.NM.Objects.Client.Client', or 'P.Nothing' on error /(Can throw 'Data.GI.Base.GError.GError')/
clientNewFinish :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAsyncResult a) =>
a -> m Client
clientNewFinish a
result_ = IO Client -> m Client
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Client -> m Client) -> IO Client -> m Client
forall a b. (a -> b) -> a -> b
$ do
    Ptr AsyncResult
result_' <- a -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
result_
    IO Client -> IO () -> IO Client
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Client
result <- (Ptr (Ptr GError) -> IO (Ptr Client)) -> IO (Ptr Client)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Client)) -> IO (Ptr Client))
-> (Ptr (Ptr GError) -> IO (Ptr Client)) -> IO (Ptr Client)
forall a b. (a -> b) -> a -> b
$ Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr Client)
nm_client_new_finish Ptr AsyncResult
result_'
        Text -> Ptr Client -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"clientNewFinish" Ptr Client
result
        Client
result' <- ((ManagedPtr Client -> Client) -> Ptr Client -> IO Client
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Client -> Client
Client) Ptr Client
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
result_
        Client -> IO Client
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Client
result'
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method Client::activate_connection_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "connection"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "Connection" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #NMConnection" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "device"
--           , argType = TInterface Name { namespace = "NM" , name = "Device" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMDevice" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "specific_object"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the object path of a connection-type-specific\n  object this activation should use. This parameter is currently ignored for\n  wired and mobile broadband connections, and the value of %NULL should be used\n  (ie, no specific object).  For Wi-Fi or WiMAX connections, pass the object\n  path of a #NMAccessPoint or #NMWimaxNsp owned by @device, which you can\n  get using nm_object_get_path(), and which will be used to complete the\n  details of the newly added connection."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "callback to be called when the activation has started"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 6
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "caller-specific data passed to @callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_activate_connection_async" nm_client_activate_connection_async :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    Ptr NM.Connection.Connection ->         -- connection : TInterface (Name {namespace = "NM", name = "Connection"})
    Ptr NM.Device.Device ->                 -- device : TInterface (Name {namespace = "NM", name = "Device"})
    CString ->                              -- specific_object : TBasicType TUTF8
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Asynchronously starts a connection to a particular network using the
-- configuration settings from /@connection@/ and the network device /@device@/.
-- Certain connection types also take a \"specific object\" which is the object
-- path of a connection- specific object, like an t'GI.NM.Objects.AccessPoint.AccessPoint' for Wi-Fi
-- connections, or an t'GI.NM.Objects.WimaxNsp.WimaxNsp' for WiMAX connections, to which you wish to
-- connect.  If the specific object is not given, NetworkManager can, in some
-- cases, automatically determine which network to connect to given the settings
-- in /@connection@/.
-- 
-- If /@connection@/ is not given for a device-based activation, NetworkManager
-- picks the best available connection for the device and activates it.
-- 
-- Note that the callback is invoked when NetworkManager has started activating
-- the new connection, not when it finishes. You can use the returned
-- t'GI.NM.Objects.ActiveConnection.ActiveConnection' object (in particular, [ActiveConnection:state]("GI.NM.Objects.ActiveConnection#g:attr:state")) to
-- track the activation to its completion.
clientActivateConnectionAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a, NM.Connection.IsConnection b, NM.Device.IsDevice c, Gio.Cancellable.IsCancellable d) =>
    a
    -- ^ /@client@/: a t'GI.NM.Objects.Client.Client'
    -> Maybe (b)
    -- ^ /@connection@/: an t'GI.NM.Interfaces.Connection.Connection'
    -> Maybe (c)
    -- ^ /@device@/: the t'GI.NM.Objects.Device.Device'
    -> Maybe (T.Text)
    -- ^ /@specificObject@/: the object path of a connection-type-specific
    --   object this activation should use. This parameter is currently ignored for
    --   wired and mobile broadband connections, and the value of 'P.Nothing' should be used
    --   (ie, no specific object).  For Wi-Fi or WiMAX connections, pass the object
    --   path of a t'GI.NM.Objects.AccessPoint.AccessPoint' or t'GI.NM.Objects.WimaxNsp.WimaxNsp' owned by /@device@/, which you can
    --   get using 'GI.NM.Objects.Object.objectGetPath', and which will be used to complete the
    --   details of the newly added connection.
    -> Maybe (d)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: callback to be called when the activation has started
    -> m ()
clientActivateConnectionAsync :: forall (m :: * -> *) a b c d.
(HasCallStack, MonadIO m, IsClient a, IsConnection b, IsDevice c,
 IsCancellable d) =>
a
-> Maybe b
-> Maybe c
-> Maybe Text
-> Maybe d
-> Maybe AsyncReadyCallback
-> m ()
clientActivateConnectionAsync a
client Maybe b
connection Maybe c
device Maybe Text
specificObject Maybe d
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr Connection
maybeConnection <- case Maybe b
connection of
        Maybe b
Nothing -> Ptr Connection -> IO (Ptr Connection)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Connection
forall a. Ptr a
FP.nullPtr
        Just b
jConnection -> do
            Ptr Connection
jConnection' <- b -> IO (Ptr Connection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jConnection
            Ptr Connection -> IO (Ptr Connection)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Connection
jConnection'
    Ptr Device
maybeDevice <- case Maybe c
device of
        Maybe c
Nothing -> Ptr Device -> IO (Ptr Device)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Device
forall a. Ptr a
FP.nullPtr
        Just c
jDevice -> do
            Ptr Device
jDevice' <- c -> IO (Ptr Device)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jDevice
            Ptr Device -> IO (Ptr Device)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Device
jDevice'
    Ptr CChar
maybeSpecificObject <- case Maybe Text
specificObject of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
FP.nullPtr
        Just Text
jSpecificObject -> do
            Ptr CChar
jSpecificObject' <- Text -> IO (Ptr CChar)
textToCString Text
jSpecificObject
            Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jSpecificObject'
    Ptr Cancellable
maybeCancellable <- case Maybe d
cancellable of
        Maybe d
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just d
jCancellable -> do
            Ptr Cancellable
jCancellable' <- d -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr d
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Client
-> Ptr Connection
-> Ptr Device
-> Ptr CChar
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
nm_client_activate_connection_async Ptr Client
client' Ptr Connection
maybeConnection Ptr Device
maybeDevice Ptr CChar
maybeSpecificObject Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
connection b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
device c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe d -> (d -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe d
cancellable d -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeSpecificObject
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ClientActivateConnectionAsyncMethodInfo
instance (signature ~ (Maybe (b) -> Maybe (c) -> Maybe (T.Text) -> Maybe (d) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsClient a, NM.Connection.IsConnection b, NM.Device.IsDevice c, Gio.Cancellable.IsCancellable d) => O.OverloadedMethod ClientActivateConnectionAsyncMethodInfo a signature where
    overloadedMethod = clientActivateConnectionAsync

instance O.OverloadedMethodInfo ClientActivateConnectionAsyncMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientActivateConnectionAsync",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientActivateConnectionAsync"
        })


#endif

-- method Client::activate_connection_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the result passed to the #GAsyncReadyCallback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "NM" , name = "ActiveConnection" })
-- throws : True
-- Skip return : False

foreign import ccall "nm_client_activate_connection_finish" nm_client_activate_connection_finish :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr NM.ActiveConnection.ActiveConnection)

-- | Gets the result of a call to 'GI.NM.Objects.Client.clientActivateConnectionAsync'.
clientActivateConnectionFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@client@/: an t'GI.NM.Objects.Client.Client'
    -> b
    -- ^ /@result@/: the result passed to the t'GI.Gio.Callbacks.AsyncReadyCallback'
    -> m NM.ActiveConnection.ActiveConnection
    -- ^ __Returns:__ the new t'GI.NM.Objects.ActiveConnection.ActiveConnection' on success, 'P.Nothing' on
    --   failure, in which case /@error@/ will be set. /(Can throw 'Data.GI.Base.GError.GError')/
clientActivateConnectionFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsClient a, IsAsyncResult b) =>
a -> b -> m ActiveConnection
clientActivateConnectionFinish a
client b
result_ = IO ActiveConnection -> m ActiveConnection
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ActiveConnection -> m ActiveConnection)
-> IO ActiveConnection -> m ActiveConnection
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO ActiveConnection -> IO () -> IO ActiveConnection
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr ActiveConnection
result <- (Ptr (Ptr GError) -> IO (Ptr ActiveConnection))
-> IO (Ptr ActiveConnection)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr ActiveConnection))
 -> IO (Ptr ActiveConnection))
-> (Ptr (Ptr GError) -> IO (Ptr ActiveConnection))
-> IO (Ptr ActiveConnection)
forall a b. (a -> b) -> a -> b
$ Ptr Client
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr ActiveConnection)
nm_client_activate_connection_finish Ptr Client
client' Ptr AsyncResult
result_'
        Text -> Ptr ActiveConnection -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"clientActivateConnectionFinish" Ptr ActiveConnection
result
        ActiveConnection
result' <- ((ManagedPtr ActiveConnection -> ActiveConnection)
-> Ptr ActiveConnection -> IO ActiveConnection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr ActiveConnection -> ActiveConnection
NM.ActiveConnection.ActiveConnection) Ptr ActiveConnection
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        ActiveConnection -> IO ActiveConnection
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ActiveConnection
result'
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data ClientActivateConnectionFinishMethodInfo
instance (signature ~ (b -> m NM.ActiveConnection.ActiveConnection), MonadIO m, IsClient a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod ClientActivateConnectionFinishMethodInfo a signature where
    overloadedMethod = clientActivateConnectionFinish

instance O.OverloadedMethodInfo ClientActivateConnectionFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientActivateConnectionFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientActivateConnectionFinish"
        })


#endif

-- method Client::add_and_activate_connection2
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "partial"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "Connection" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "an #NMConnection to add; the connection may be\n  partially filled (or even %NULL) and will be completed by NetworkManager\n  using the given @device and @specific_object before being added"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "device"
--           , argType = TInterface Name { namespace = "NM" , name = "Device" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMDevice" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "specific_object"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the object path of a connection-type-specific\n  object this activation should use. This parameter is currently ignored for\n  wired and mobile broadband connections, and the value of %NULL should be used\n  (i.e., no specific object).  For Wi-Fi or WiMAX connections, pass the object\n  path of a #NMAccessPoint or #NMWimaxNsp owned by @device, which you can\n  get using nm_object_get_path(), and which will be used to complete the\n  details of the newly added connection."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "options"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GVariant containing a dictionary with options, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "callback to be called when the activation has started"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 7
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "caller-specific data passed to @callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_add_and_activate_connection2" nm_client_add_and_activate_connection2 :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    Ptr NM.Connection.Connection ->         -- partial : TInterface (Name {namespace = "NM", name = "Connection"})
    Ptr NM.Device.Device ->                 -- device : TInterface (Name {namespace = "NM", name = "Device"})
    CString ->                              -- specific_object : TBasicType TUTF8
    Ptr GVariant ->                         -- options : TVariant
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Adds a new connection using the given details (if any) as a template,
-- automatically filling in missing settings with the capabilities of the given
-- device and specific object.  The new connection is then asynchronously
-- activated as with 'GI.NM.Objects.Client.clientActivateConnectionAsync'. Cannot be used for
-- VPN connections at this time.
-- 
-- Note that the callback is invoked when NetworkManager has started activating
-- the new connection, not when it finishes. You can used the returned
-- t'GI.NM.Objects.ActiveConnection.ActiveConnection' object (in particular, [ActiveConnection:state]("GI.NM.Objects.ActiveConnection#g:attr:state")) to
-- track the activation to its completion.
-- 
-- This is identical to 'GI.NM.Objects.Client.clientAddAndActivateConnectionAsync' but takes
-- a further /@options@/ parameter. Currently, the following options are supported
-- by the daemon:
--  * \"persist\": A string describing how the connection should be stored.
--               The default is \"disk\", but it can be modified to \"memory\" (until
--               the daemon quits) or \"volatile\" (will be deleted on disconnect).
--  * \"bind-activation\": Bind the connection lifetime to something. The default is \"none\",
--            meaning an explicit disconnect is needed. The value \"dbus-client\"
--            means the connection will automatically be deactivated when the calling
--            D-Bus client disappears from the system bus.
-- 
-- /Since: 1.16/
clientAddAndActivateConnection2 ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a, NM.Connection.IsConnection b, NM.Device.IsDevice c, Gio.Cancellable.IsCancellable d) =>
    a
    -- ^ /@client@/: a t'GI.NM.Objects.Client.Client'
    -> Maybe (b)
    -- ^ /@partial@/: an t'GI.NM.Interfaces.Connection.Connection' to add; the connection may be
    --   partially filled (or even 'P.Nothing') and will be completed by NetworkManager
    --   using the given /@device@/ and /@specificObject@/ before being added
    -> Maybe (c)
    -- ^ /@device@/: the t'GI.NM.Objects.Device.Device'
    -> Maybe (T.Text)
    -- ^ /@specificObject@/: the object path of a connection-type-specific
    --   object this activation should use. This parameter is currently ignored for
    --   wired and mobile broadband connections, and the value of 'P.Nothing' should be used
    --   (i.e., no specific object).  For Wi-Fi or WiMAX connections, pass the object
    --   path of a t'GI.NM.Objects.AccessPoint.AccessPoint' or t'GI.NM.Objects.WimaxNsp.WimaxNsp' owned by /@device@/, which you can
    --   get using 'GI.NM.Objects.Object.objectGetPath', and which will be used to complete the
    --   details of the newly added connection.
    -> GVariant
    -- ^ /@options@/: a t'GVariant' containing a dictionary with options, or 'P.Nothing'
    -> Maybe (d)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: callback to be called when the activation has started
    -> m ()
clientAddAndActivateConnection2 :: forall (m :: * -> *) a b c d.
(HasCallStack, MonadIO m, IsClient a, IsConnection b, IsDevice c,
 IsCancellable d) =>
a
-> Maybe b
-> Maybe c
-> Maybe Text
-> GVariant
-> Maybe d
-> Maybe AsyncReadyCallback
-> m ()
clientAddAndActivateConnection2 a
client Maybe b
partial Maybe c
device Maybe Text
specificObject GVariant
options Maybe d
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr Connection
maybePartial <- case Maybe b
partial of
        Maybe b
Nothing -> Ptr Connection -> IO (Ptr Connection)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Connection
forall a. Ptr a
FP.nullPtr
        Just b
jPartial -> do
            Ptr Connection
jPartial' <- b -> IO (Ptr Connection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jPartial
            Ptr Connection -> IO (Ptr Connection)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Connection
jPartial'
    Ptr Device
maybeDevice <- case Maybe c
device of
        Maybe c
Nothing -> Ptr Device -> IO (Ptr Device)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Device
forall a. Ptr a
FP.nullPtr
        Just c
jDevice -> do
            Ptr Device
jDevice' <- c -> IO (Ptr Device)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jDevice
            Ptr Device -> IO (Ptr Device)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Device
jDevice'
    Ptr CChar
maybeSpecificObject <- case Maybe Text
specificObject of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
FP.nullPtr
        Just Text
jSpecificObject -> do
            Ptr CChar
jSpecificObject' <- Text -> IO (Ptr CChar)
textToCString Text
jSpecificObject
            Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jSpecificObject'
    Ptr GVariant
options' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
options
    Ptr Cancellable
maybeCancellable <- case Maybe d
cancellable of
        Maybe d
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just d
jCancellable -> do
            Ptr Cancellable
jCancellable' <- d -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr d
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Client
-> Ptr Connection
-> Ptr Device
-> Ptr CChar
-> Ptr GVariant
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
nm_client_add_and_activate_connection2 Ptr Client
client' Ptr Connection
maybePartial Ptr Device
maybeDevice Ptr CChar
maybeSpecificObject Ptr GVariant
options' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
partial b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
device c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GVariant
options
    Maybe d -> (d -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe d
cancellable d -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeSpecificObject
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ClientAddAndActivateConnection2MethodInfo
instance (signature ~ (Maybe (b) -> Maybe (c) -> Maybe (T.Text) -> GVariant -> Maybe (d) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsClient a, NM.Connection.IsConnection b, NM.Device.IsDevice c, Gio.Cancellable.IsCancellable d) => O.OverloadedMethod ClientAddAndActivateConnection2MethodInfo a signature where
    overloadedMethod = clientAddAndActivateConnection2

instance O.OverloadedMethodInfo ClientAddAndActivateConnection2MethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientAddAndActivateConnection2",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientAddAndActivateConnection2"
        })


#endif

-- method Client::add_and_activate_connection2_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the result passed to the #GAsyncReadyCallback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_result"
--           , argType = TVariant
--           , direction = DirectionOut
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the output result\n  of type \"a{sv}\" returned by D-Bus' AddAndActivate2 call. Currently, no\n  output is implemented yet."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "NM" , name = "ActiveConnection" })
-- throws : True
-- Skip return : False

foreign import ccall "nm_client_add_and_activate_connection2_finish" nm_client_add_and_activate_connection2_finish :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GVariant) ->                   -- out_result : TVariant
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr NM.ActiveConnection.ActiveConnection)

-- | Gets the result of a call to 'GI.NM.Objects.Client.clientAddAndActivateConnection2'.
-- 
-- You can call 'GI.NM.Objects.ActiveConnection.activeConnectionGetConnection' on the returned
-- t'GI.NM.Objects.ActiveConnection.ActiveConnection' to find the path of the created t'GI.NM.Interfaces.Connection.Connection'.
-- 
-- /Since: 1.16/
clientAddAndActivateConnection2Finish ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@client@/: an t'GI.NM.Objects.Client.Client'
    -> b
    -- ^ /@result@/: the result passed to the t'GI.Gio.Callbacks.AsyncReadyCallback'
    -> m ((NM.ActiveConnection.ActiveConnection, Maybe GVariant))
    -- ^ __Returns:__ the new t'GI.NM.Objects.ActiveConnection.ActiveConnection' on success, 'P.Nothing' on
    --   failure, in which case /@error@/ will be set. /(Can throw 'Data.GI.Base.GError.GError')/
clientAddAndActivateConnection2Finish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsClient a, IsAsyncResult b) =>
a -> b -> m (ActiveConnection, Maybe GVariant)
clientAddAndActivateConnection2Finish a
client b
result_ = IO (ActiveConnection, Maybe GVariant)
-> m (ActiveConnection, Maybe GVariant)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ActiveConnection, Maybe GVariant)
 -> m (ActiveConnection, Maybe GVariant))
-> IO (ActiveConnection, Maybe GVariant)
-> m (ActiveConnection, Maybe GVariant)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    Ptr (Ptr GVariant)
outResult <- IO (Ptr (Ptr GVariant))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr GVariant))
    IO (ActiveConnection, Maybe GVariant)
-> IO () -> IO (ActiveConnection, Maybe GVariant)
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr ActiveConnection
result <- (Ptr (Ptr GError) -> IO (Ptr ActiveConnection))
-> IO (Ptr ActiveConnection)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr ActiveConnection))
 -> IO (Ptr ActiveConnection))
-> (Ptr (Ptr GError) -> IO (Ptr ActiveConnection))
-> IO (Ptr ActiveConnection)
forall a b. (a -> b) -> a -> b
$ Ptr Client
-> Ptr AsyncResult
-> Ptr (Ptr GVariant)
-> Ptr (Ptr GError)
-> IO (Ptr ActiveConnection)
nm_client_add_and_activate_connection2_finish Ptr Client
client' Ptr AsyncResult
result_' Ptr (Ptr GVariant)
outResult
        Text -> Ptr ActiveConnection -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"clientAddAndActivateConnection2Finish" Ptr ActiveConnection
result
        ActiveConnection
result' <- ((ManagedPtr ActiveConnection -> ActiveConnection)
-> Ptr ActiveConnection -> IO ActiveConnection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr ActiveConnection -> ActiveConnection
NM.ActiveConnection.ActiveConnection) Ptr ActiveConnection
result
        Ptr GVariant
outResult' <- Ptr (Ptr GVariant) -> IO (Ptr GVariant)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr GVariant)
outResult
        Maybe GVariant
maybeOutResult' <- Ptr GVariant
-> (Ptr GVariant -> IO GVariant) -> IO (Maybe GVariant)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr GVariant
outResult' ((Ptr GVariant -> IO GVariant) -> IO (Maybe GVariant))
-> (Ptr GVariant -> IO GVariant) -> IO (Maybe GVariant)
forall a b. (a -> b) -> a -> b
$ \Ptr GVariant
outResult'' -> do
            GVariant
outResult''' <- Ptr GVariant -> IO GVariant
B.GVariant.wrapGVariantPtr Ptr GVariant
outResult''
            GVariant -> IO GVariant
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GVariant
outResult'''
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        Ptr (Ptr GVariant) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr GVariant)
outResult
        (ActiveConnection, Maybe GVariant)
-> IO (ActiveConnection, Maybe GVariant)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ActiveConnection
result', Maybe GVariant
maybeOutResult')
     ) (do
        Ptr (Ptr GVariant) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr GVariant)
outResult
     )

#if defined(ENABLE_OVERLOADING)
data ClientAddAndActivateConnection2FinishMethodInfo
instance (signature ~ (b -> m ((NM.ActiveConnection.ActiveConnection, Maybe GVariant))), MonadIO m, IsClient a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod ClientAddAndActivateConnection2FinishMethodInfo a signature where
    overloadedMethod = clientAddAndActivateConnection2Finish

instance O.OverloadedMethodInfo ClientAddAndActivateConnection2FinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientAddAndActivateConnection2Finish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientAddAndActivateConnection2Finish"
        })


#endif

-- method Client::add_and_activate_connection_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "partial"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "Connection" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "an #NMConnection to add; the connection may be\n  partially filled (or even %NULL) and will be completed by NetworkManager\n  using the given @device and @specific_object before being added"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "device"
--           , argType = TInterface Name { namespace = "NM" , name = "Device" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMDevice" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "specific_object"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the object path of a connection-type-specific\n  object this activation should use. This parameter is currently ignored for\n  wired and mobile broadband connections, and the value of %NULL should be used\n  (ie, no specific object).  For Wi-Fi or WiMAX connections, pass the object\n  path of a #NMAccessPoint or #NMWimaxNsp owned by @device, which you can\n  get using nm_object_get_path(), and which will be used to complete the\n  details of the newly added connection.\n  If the variant is floating, it will be consumed."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "callback to be called when the activation has started"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 6
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "caller-specific data passed to @callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_add_and_activate_connection_async" nm_client_add_and_activate_connection_async :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    Ptr NM.Connection.Connection ->         -- partial : TInterface (Name {namespace = "NM", name = "Connection"})
    Ptr NM.Device.Device ->                 -- device : TInterface (Name {namespace = "NM", name = "Device"})
    CString ->                              -- specific_object : TBasicType TUTF8
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Adds a new connection using the given details (if any) as a template,
-- automatically filling in missing settings with the capabilities of the given
-- device and specific object.  The new connection is then asynchronously
-- activated as with 'GI.NM.Objects.Client.clientActivateConnectionAsync'. Cannot be used for
-- VPN connections at this time.
-- 
-- Note that the callback is invoked when NetworkManager has started activating
-- the new connection, not when it finishes. You can used the returned
-- t'GI.NM.Objects.ActiveConnection.ActiveConnection' object (in particular, [ActiveConnection:state]("GI.NM.Objects.ActiveConnection#g:attr:state")) to
-- track the activation to its completion.
clientAddAndActivateConnectionAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a, NM.Connection.IsConnection b, NM.Device.IsDevice c, Gio.Cancellable.IsCancellable d) =>
    a
    -- ^ /@client@/: a t'GI.NM.Objects.Client.Client'
    -> Maybe (b)
    -- ^ /@partial@/: an t'GI.NM.Interfaces.Connection.Connection' to add; the connection may be
    --   partially filled (or even 'P.Nothing') and will be completed by NetworkManager
    --   using the given /@device@/ and /@specificObject@/ before being added
    -> Maybe (c)
    -- ^ /@device@/: the t'GI.NM.Objects.Device.Device'
    -> Maybe (T.Text)
    -- ^ /@specificObject@/: the object path of a connection-type-specific
    --   object this activation should use. This parameter is currently ignored for
    --   wired and mobile broadband connections, and the value of 'P.Nothing' should be used
    --   (ie, no specific object).  For Wi-Fi or WiMAX connections, pass the object
    --   path of a t'GI.NM.Objects.AccessPoint.AccessPoint' or t'GI.NM.Objects.WimaxNsp.WimaxNsp' owned by /@device@/, which you can
    --   get using 'GI.NM.Objects.Object.objectGetPath', and which will be used to complete the
    --   details of the newly added connection.
    --   If the variant is floating, it will be consumed.
    -> Maybe (d)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: callback to be called when the activation has started
    -> m ()
clientAddAndActivateConnectionAsync :: forall (m :: * -> *) a b c d.
(HasCallStack, MonadIO m, IsClient a, IsConnection b, IsDevice c,
 IsCancellable d) =>
a
-> Maybe b
-> Maybe c
-> Maybe Text
-> Maybe d
-> Maybe AsyncReadyCallback
-> m ()
clientAddAndActivateConnectionAsync a
client Maybe b
partial Maybe c
device Maybe Text
specificObject Maybe d
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr Connection
maybePartial <- case Maybe b
partial of
        Maybe b
Nothing -> Ptr Connection -> IO (Ptr Connection)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Connection
forall a. Ptr a
FP.nullPtr
        Just b
jPartial -> do
            Ptr Connection
jPartial' <- b -> IO (Ptr Connection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jPartial
            Ptr Connection -> IO (Ptr Connection)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Connection
jPartial'
    Ptr Device
maybeDevice <- case Maybe c
device of
        Maybe c
Nothing -> Ptr Device -> IO (Ptr Device)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Device
forall a. Ptr a
FP.nullPtr
        Just c
jDevice -> do
            Ptr Device
jDevice' <- c -> IO (Ptr Device)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jDevice
            Ptr Device -> IO (Ptr Device)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Device
jDevice'
    Ptr CChar
maybeSpecificObject <- case Maybe Text
specificObject of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
FP.nullPtr
        Just Text
jSpecificObject -> do
            Ptr CChar
jSpecificObject' <- Text -> IO (Ptr CChar)
textToCString Text
jSpecificObject
            Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jSpecificObject'
    Ptr Cancellable
maybeCancellable <- case Maybe d
cancellable of
        Maybe d
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just d
jCancellable -> do
            Ptr Cancellable
jCancellable' <- d -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr d
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Client
-> Ptr Connection
-> Ptr Device
-> Ptr CChar
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
nm_client_add_and_activate_connection_async Ptr Client
client' Ptr Connection
maybePartial Ptr Device
maybeDevice Ptr CChar
maybeSpecificObject Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
partial b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
device c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe d -> (d -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe d
cancellable d -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeSpecificObject
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ClientAddAndActivateConnectionAsyncMethodInfo
instance (signature ~ (Maybe (b) -> Maybe (c) -> Maybe (T.Text) -> Maybe (d) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsClient a, NM.Connection.IsConnection b, NM.Device.IsDevice c, Gio.Cancellable.IsCancellable d) => O.OverloadedMethod ClientAddAndActivateConnectionAsyncMethodInfo a signature where
    overloadedMethod = clientAddAndActivateConnectionAsync

instance O.OverloadedMethodInfo ClientAddAndActivateConnectionAsyncMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientAddAndActivateConnectionAsync",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientAddAndActivateConnectionAsync"
        })


#endif

-- method Client::add_and_activate_connection_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the result passed to the #GAsyncReadyCallback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "NM" , name = "ActiveConnection" })
-- throws : True
-- Skip return : False

foreign import ccall "nm_client_add_and_activate_connection_finish" nm_client_add_and_activate_connection_finish :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr NM.ActiveConnection.ActiveConnection)

-- | Gets the result of a call to 'GI.NM.Objects.Client.clientAddAndActivateConnectionAsync'.
-- 
-- You can call 'GI.NM.Objects.ActiveConnection.activeConnectionGetConnection' on the returned
-- t'GI.NM.Objects.ActiveConnection.ActiveConnection' to find the path of the created t'GI.NM.Interfaces.Connection.Connection'.
clientAddAndActivateConnectionFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@client@/: an t'GI.NM.Objects.Client.Client'
    -> b
    -- ^ /@result@/: the result passed to the t'GI.Gio.Callbacks.AsyncReadyCallback'
    -> m NM.ActiveConnection.ActiveConnection
    -- ^ __Returns:__ the new t'GI.NM.Objects.ActiveConnection.ActiveConnection' on success, 'P.Nothing' on
    --   failure, in which case /@error@/ will be set. /(Can throw 'Data.GI.Base.GError.GError')/
clientAddAndActivateConnectionFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsClient a, IsAsyncResult b) =>
a -> b -> m ActiveConnection
clientAddAndActivateConnectionFinish a
client b
result_ = IO ActiveConnection -> m ActiveConnection
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ActiveConnection -> m ActiveConnection)
-> IO ActiveConnection -> m ActiveConnection
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO ActiveConnection -> IO () -> IO ActiveConnection
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr ActiveConnection
result <- (Ptr (Ptr GError) -> IO (Ptr ActiveConnection))
-> IO (Ptr ActiveConnection)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr ActiveConnection))
 -> IO (Ptr ActiveConnection))
-> (Ptr (Ptr GError) -> IO (Ptr ActiveConnection))
-> IO (Ptr ActiveConnection)
forall a b. (a -> b) -> a -> b
$ Ptr Client
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr ActiveConnection)
nm_client_add_and_activate_connection_finish Ptr Client
client' Ptr AsyncResult
result_'
        Text -> Ptr ActiveConnection -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"clientAddAndActivateConnectionFinish" Ptr ActiveConnection
result
        ActiveConnection
result' <- ((ManagedPtr ActiveConnection -> ActiveConnection)
-> Ptr ActiveConnection -> IO ActiveConnection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr ActiveConnection -> ActiveConnection
NM.ActiveConnection.ActiveConnection) Ptr ActiveConnection
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        ActiveConnection -> IO ActiveConnection
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ActiveConnection
result'
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data ClientAddAndActivateConnectionFinishMethodInfo
instance (signature ~ (b -> m NM.ActiveConnection.ActiveConnection), MonadIO m, IsClient a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod ClientAddAndActivateConnectionFinishMethodInfo a signature where
    overloadedMethod = clientAddAndActivateConnectionFinish

instance O.OverloadedMethodInfo ClientAddAndActivateConnectionFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientAddAndActivateConnectionFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientAddAndActivateConnectionFinish"
        })


#endif

-- method Client::add_connection2
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the %NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "settings"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the \"a{sa{sv}}\" #GVariant with the content of the setting."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "NM" , name = "SettingsAddConnection2Flags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the %NMSettingsAddConnection2Flags argument."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "args"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the \"a{sv}\" #GVariant with extra argument or %NULL\n  for no extra arguments."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ignore_out_result"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "this function wraps AddConnection2(), which has an\n  additional result \"a{sv}\" output parameter. By setting this to %TRUE,\n  you signal that you are not interested in that output parameter.\n  This allows the function to fall back to AddConnection() and AddConnectionUnsaved(),\n  which is interesting if you run against an older server version that does\n  not yet provide AddConnection2(). By setting this to %FALSE, the function\n  under the hood always calls AddConnection2()."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "callback to be called when the add operation completes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 7
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "caller-specific data passed to @callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_add_connection2" nm_client_add_connection2 :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    Ptr GVariant ->                         -- settings : TVariant
    CUInt ->                                -- flags : TInterface (Name {namespace = "NM", name = "SettingsAddConnection2Flags"})
    Ptr GVariant ->                         -- args : TVariant
    CInt ->                                 -- ignore_out_result : TBasicType TBoolean
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Call @/AddConnection2()/@ D-Bus API asynchronously.
-- 
-- /Since: 1.20/
clientAddConnection2 ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@client@/: the @/NMClient/@
    -> GVariant
    -- ^ /@settings@/: the \"a{sa{sv}}\" t'GVariant' with the content of the setting.
    -> [NM.Flags.SettingsAddConnection2Flags]
    -- ^ /@flags@/: the @/NMSettingsAddConnection2Flags/@ argument.
    -> Maybe (GVariant)
    -- ^ /@args@/: the \"a{sv}\" t'GVariant' with extra argument or 'P.Nothing'
    --   for no extra arguments.
    -> Bool
    -- ^ /@ignoreOutResult@/: this function wraps @/AddConnection2()/@, which has an
    --   additional result \"a{sv}\" output parameter. By setting this to 'P.True',
    --   you signal that you are not interested in that output parameter.
    --   This allows the function to fall back to @/AddConnection()/@ and @/AddConnectionUnsaved()/@,
    --   which is interesting if you run against an older server version that does
    --   not yet provide @/AddConnection2()/@. By setting this to 'P.False', the function
    --   under the hood always calls @/AddConnection2()/@.
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: callback to be called when the add operation completes
    -> m ()
clientAddConnection2 :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsClient a, IsCancellable b) =>
a
-> GVariant
-> [SettingsAddConnection2Flags]
-> Maybe GVariant
-> Bool
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
clientAddConnection2 a
client GVariant
settings [SettingsAddConnection2Flags]
flags Maybe GVariant
args Bool
ignoreOutResult Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr GVariant
settings' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
settings
    let flags' :: CUInt
flags' = [SettingsAddConnection2Flags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [SettingsAddConnection2Flags]
flags
    Ptr GVariant
maybeArgs <- case Maybe GVariant
args of
        Maybe GVariant
Nothing -> Ptr GVariant -> IO (Ptr GVariant)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GVariant
forall a. Ptr a
FP.nullPtr
        Just GVariant
jArgs -> do
            Ptr GVariant
jArgs' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
jArgs
            Ptr GVariant -> IO (Ptr GVariant)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GVariant
jArgs'
    let ignoreOutResult' :: CInt
ignoreOutResult' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
ignoreOutResult
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Client
-> Ptr GVariant
-> CUInt
-> Ptr GVariant
-> CInt
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
nm_client_add_connection2 Ptr Client
client' Ptr GVariant
settings' CUInt
flags' Ptr GVariant
maybeArgs CInt
ignoreOutResult' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GVariant
settings
    Maybe GVariant -> (GVariant -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe GVariant
args GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ClientAddConnection2MethodInfo
instance (signature ~ (GVariant -> [NM.Flags.SettingsAddConnection2Flags] -> Maybe (GVariant) -> Bool -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsClient a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod ClientAddConnection2MethodInfo a signature where
    overloadedMethod = clientAddConnection2

instance O.OverloadedMethodInfo ClientAddConnection2MethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientAddConnection2",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientAddConnection2"
        })


#endif

-- method Client::add_connection2_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GAsyncResult" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_result"
--           , argType = TVariant
--           , direction = DirectionOut
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the output\n  #GVariant from AddConnection2().\n  If you care about the output result, then the \"ignore_out_result\"\n  parameter of nm_client_add_connection2() must not be set to %TRUE."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "NM" , name = "RemoteConnection" })
-- throws : True
-- Skip return : False

foreign import ccall "nm_client_add_connection2_finish" nm_client_add_connection2_finish :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GVariant) ->                   -- out_result : TVariant
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr NM.RemoteConnection.RemoteConnection)

-- | /No description available in the introspection data./
-- 
-- /Since: 1.20/
clientAddConnection2Finish ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@client@/: the t'GI.NM.Objects.Client.Client'
    -> b
    -- ^ /@result@/: the t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m ((NM.RemoteConnection.RemoteConnection, Maybe GVariant))
    -- ^ __Returns:__ on success, a pointer to the added
    --   t'GI.NM.Objects.RemoteConnection.RemoteConnection'. /(Can throw 'Data.GI.Base.GError.GError')/
clientAddConnection2Finish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsClient a, IsAsyncResult b) =>
a -> b -> m (RemoteConnection, Maybe GVariant)
clientAddConnection2Finish a
client b
result_ = IO (RemoteConnection, Maybe GVariant)
-> m (RemoteConnection, Maybe GVariant)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (RemoteConnection, Maybe GVariant)
 -> m (RemoteConnection, Maybe GVariant))
-> IO (RemoteConnection, Maybe GVariant)
-> m (RemoteConnection, Maybe GVariant)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    Ptr (Ptr GVariant)
outResult <- IO (Ptr (Ptr GVariant))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr GVariant))
    IO (RemoteConnection, Maybe GVariant)
-> IO () -> IO (RemoteConnection, Maybe GVariant)
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr RemoteConnection
result <- (Ptr (Ptr GError) -> IO (Ptr RemoteConnection))
-> IO (Ptr RemoteConnection)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr RemoteConnection))
 -> IO (Ptr RemoteConnection))
-> (Ptr (Ptr GError) -> IO (Ptr RemoteConnection))
-> IO (Ptr RemoteConnection)
forall a b. (a -> b) -> a -> b
$ Ptr Client
-> Ptr AsyncResult
-> Ptr (Ptr GVariant)
-> Ptr (Ptr GError)
-> IO (Ptr RemoteConnection)
nm_client_add_connection2_finish Ptr Client
client' Ptr AsyncResult
result_' Ptr (Ptr GVariant)
outResult
        Text -> Ptr RemoteConnection -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"clientAddConnection2Finish" Ptr RemoteConnection
result
        RemoteConnection
result' <- ((ManagedPtr RemoteConnection -> RemoteConnection)
-> Ptr RemoteConnection -> IO RemoteConnection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr RemoteConnection -> RemoteConnection
NM.RemoteConnection.RemoteConnection) Ptr RemoteConnection
result
        Ptr GVariant
outResult' <- Ptr (Ptr GVariant) -> IO (Ptr GVariant)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr GVariant)
outResult
        Maybe GVariant
maybeOutResult' <- Ptr GVariant
-> (Ptr GVariant -> IO GVariant) -> IO (Maybe GVariant)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr GVariant
outResult' ((Ptr GVariant -> IO GVariant) -> IO (Maybe GVariant))
-> (Ptr GVariant -> IO GVariant) -> IO (Maybe GVariant)
forall a b. (a -> b) -> a -> b
$ \Ptr GVariant
outResult'' -> do
            GVariant
outResult''' <- Ptr GVariant -> IO GVariant
B.GVariant.wrapGVariantPtr Ptr GVariant
outResult''
            GVariant -> IO GVariant
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GVariant
outResult'''
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        Ptr (Ptr GVariant) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr GVariant)
outResult
        (RemoteConnection, Maybe GVariant)
-> IO (RemoteConnection, Maybe GVariant)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (RemoteConnection
result', Maybe GVariant
maybeOutResult')
     ) (do
        Ptr (Ptr GVariant) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr GVariant)
outResult
     )

#if defined(ENABLE_OVERLOADING)
data ClientAddConnection2FinishMethodInfo
instance (signature ~ (b -> m ((NM.RemoteConnection.RemoteConnection, Maybe GVariant))), MonadIO m, IsClient a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod ClientAddConnection2FinishMethodInfo a signature where
    overloadedMethod = clientAddConnection2Finish

instance O.OverloadedMethodInfo ClientAddConnection2FinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientAddConnection2Finish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientAddConnection2Finish"
        })


#endif

-- method Client::add_connection_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the %NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "connection"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "Connection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the connection to add. Note that this object's settings will be\n  added, not the object itself"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "save_to_disk"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "whether to immediately save the connection to disk"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "callback to be called when the add operation completes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "caller-specific data passed to @callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_add_connection_async" nm_client_add_connection_async :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    Ptr NM.Connection.Connection ->         -- connection : TInterface (Name {namespace = "NM", name = "Connection"})
    CInt ->                                 -- save_to_disk : TBasicType TBoolean
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Requests that the remote settings service add the given settings to a new
-- connection.  If /@saveToDisk@/ is 'P.True', the connection is immediately written
-- to disk; otherwise it is initially only stored in memory, but may be saved
-- later by calling the connection\'s 'GI.NM.Objects.RemoteConnection.remoteConnectionCommitChanges'
-- method.
-- 
-- /@connection@/ is untouched by this function and only serves as a template of
-- the settings to add.  The t'GI.NM.Objects.RemoteConnection.RemoteConnection' object that represents what
-- NetworkManager actually added is returned to /@callback@/ when the addition
-- operation is complete.
-- 
-- Note that the t'GI.NM.Objects.RemoteConnection.RemoteConnection' returned in /@callback@/ may not contain
-- identical settings to /@connection@/ as NetworkManager may perform automatic
-- completion and\/or normalization of connection properties.
clientAddConnectionAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a, NM.Connection.IsConnection b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@client@/: the @/NMClient/@
    -> b
    -- ^ /@connection@/: the connection to add. Note that this object\'s settings will be
    --   added, not the object itself
    -> Bool
    -- ^ /@saveToDisk@/: whether to immediately save the connection to disk
    -> Maybe (c)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: callback to be called when the add operation completes
    -> m ()
clientAddConnectionAsync :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsClient a, IsConnection b,
 IsCancellable c) =>
a -> b -> Bool -> Maybe c -> Maybe AsyncReadyCallback -> m ()
clientAddConnectionAsync a
client b
connection Bool
saveToDisk Maybe c
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr Connection
connection' <- b -> IO (Ptr Connection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
connection
    let saveToDisk' :: CInt
saveToDisk' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
saveToDisk
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Client
-> Ptr Connection
-> CInt
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
nm_client_add_connection_async Ptr Client
client' Ptr Connection
connection' CInt
saveToDisk' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
connection
    Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ClientAddConnectionAsyncMethodInfo
instance (signature ~ (b -> Bool -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsClient a, NM.Connection.IsConnection b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod ClientAddConnectionAsyncMethodInfo a signature where
    overloadedMethod = clientAddConnectionAsync

instance O.OverloadedMethodInfo ClientAddConnectionAsyncMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientAddConnectionAsync",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientAddConnectionAsync"
        })


#endif

-- method Client::add_connection_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the result passed to the #GAsyncReadyCallback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "NM" , name = "RemoteConnection" })
-- throws : True
-- Skip return : False

foreign import ccall "nm_client_add_connection_finish" nm_client_add_connection_finish :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr NM.RemoteConnection.RemoteConnection)

-- | Gets the result of a call to 'GI.NM.Objects.Client.clientAddConnectionAsync'.
clientAddConnectionFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@client@/: an t'GI.NM.Objects.Client.Client'
    -> b
    -- ^ /@result@/: the result passed to the t'GI.Gio.Callbacks.AsyncReadyCallback'
    -> m NM.RemoteConnection.RemoteConnection
    -- ^ __Returns:__ the new t'GI.NM.Objects.RemoteConnection.RemoteConnection' on success, 'P.Nothing' on
    --   failure, in which case /@error@/ will be set. /(Can throw 'Data.GI.Base.GError.GError')/
clientAddConnectionFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsClient a, IsAsyncResult b) =>
a -> b -> m RemoteConnection
clientAddConnectionFinish a
client b
result_ = IO RemoteConnection -> m RemoteConnection
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RemoteConnection -> m RemoteConnection)
-> IO RemoteConnection -> m RemoteConnection
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO RemoteConnection -> IO () -> IO RemoteConnection
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr RemoteConnection
result <- (Ptr (Ptr GError) -> IO (Ptr RemoteConnection))
-> IO (Ptr RemoteConnection)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr RemoteConnection))
 -> IO (Ptr RemoteConnection))
-> (Ptr (Ptr GError) -> IO (Ptr RemoteConnection))
-> IO (Ptr RemoteConnection)
forall a b. (a -> b) -> a -> b
$ Ptr Client
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr RemoteConnection)
nm_client_add_connection_finish Ptr Client
client' Ptr AsyncResult
result_'
        Text -> Ptr RemoteConnection -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"clientAddConnectionFinish" Ptr RemoteConnection
result
        RemoteConnection
result' <- ((ManagedPtr RemoteConnection -> RemoteConnection)
-> Ptr RemoteConnection -> IO RemoteConnection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr RemoteConnection -> RemoteConnection
NM.RemoteConnection.RemoteConnection) Ptr RemoteConnection
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        RemoteConnection -> IO RemoteConnection
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return RemoteConnection
result'
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data ClientAddConnectionFinishMethodInfo
instance (signature ~ (b -> m NM.RemoteConnection.RemoteConnection), MonadIO m, IsClient a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod ClientAddConnectionFinishMethodInfo a signature where
    overloadedMethod = clientAddConnectionFinish

instance O.OverloadedMethodInfo ClientAddConnectionFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientAddConnectionFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientAddConnectionFinish"
        })


#endif

-- method Client::check_connectivity
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "NM" , name = "ConnectivityState" })
-- throws : True
-- Skip return : False

foreign import ccall "nm_client_check_connectivity" nm_client_check_connectivity :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CUInt

{-# DEPRECATED clientCheckConnectivity ["(Since version 1.22)","Use 'GI.NM.Objects.Client.clientCheckConnectivityAsync' or GDBusConnection."] #-}
-- | Updates the network connectivity state and returns the (new)
-- current state. Contrast 'GI.NM.Objects.Client.clientGetConnectivity', which returns
-- the most recent known state without re-checking.
-- 
-- This is a blocking call; use 'GI.NM.Objects.Client.clientCheckConnectivityAsync'
-- if you do not want to block.
clientCheckConnectivity ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@client@/: an t'GI.NM.Objects.Client.Client'
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable'
    -> m NM.Enums.ConnectivityState
    -- ^ __Returns:__ the (new) current connectivity state /(Can throw 'Data.GI.Base.GError.GError')/
clientCheckConnectivity :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsClient a, IsCancellable b) =>
a -> Maybe b -> m ConnectivityState
clientCheckConnectivity a
client Maybe b
cancellable = IO ConnectivityState -> m ConnectivityState
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ConnectivityState -> m ConnectivityState)
-> IO ConnectivityState -> m ConnectivityState
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO ConnectivityState -> IO () -> IO ConnectivityState
forall a b. IO a -> IO b -> IO a
onException (do
        CUInt
result <- (Ptr (Ptr GError) -> IO CUInt) -> IO CUInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CUInt) -> IO CUInt)
-> (Ptr (Ptr GError) -> IO CUInt) -> IO CUInt
forall a b. (a -> b) -> a -> b
$ Ptr Client -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CUInt
nm_client_check_connectivity Ptr Client
client' Ptr Cancellable
maybeCancellable
        let result' :: ConnectivityState
result' = (Int -> ConnectivityState
forall a. Enum a => Int -> a
toEnum (Int -> ConnectivityState)
-> (CUInt -> Int) -> CUInt -> ConnectivityState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        ConnectivityState -> IO ConnectivityState
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ConnectivityState
result'
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data ClientCheckConnectivityMethodInfo
instance (signature ~ (Maybe (b) -> m NM.Enums.ConnectivityState), MonadIO m, IsClient a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod ClientCheckConnectivityMethodInfo a signature where
    overloadedMethod = clientCheckConnectivity

instance O.OverloadedMethodInfo ClientCheckConnectivityMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientCheckConnectivity",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientCheckConnectivity"
        })


#endif

-- method Client::check_connectivity_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "callback to call with the result"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 3
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data for @callback."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_check_connectivity_async" nm_client_check_connectivity_async :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Asynchronously updates the network connectivity state and invokes
-- /@callback@/ when complete. Contrast 'GI.NM.Objects.Client.clientGetConnectivity',
-- which (immediately) returns the most recent known state without
-- re-checking, and 'GI.NM.Objects.Client.clientCheckConnectivity', which blocks.
clientCheckConnectivityAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@client@/: an t'GI.NM.Objects.Client.Client'
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable'
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: callback to call with the result
    -> m ()
clientCheckConnectivityAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsClient a, IsCancellable b) =>
a -> Maybe b -> Maybe AsyncReadyCallback -> m ()
clientCheckConnectivityAsync a
client Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Client
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
nm_client_check_connectivity_async Ptr Client
client' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ClientCheckConnectivityAsyncMethodInfo
instance (signature ~ (Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsClient a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod ClientCheckConnectivityAsyncMethodInfo a signature where
    overloadedMethod = clientCheckConnectivityAsync

instance O.OverloadedMethodInfo ClientCheckConnectivityAsyncMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientCheckConnectivityAsync",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientCheckConnectivityAsync"
        })


#endif

-- method Client::check_connectivity_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GAsyncResult" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "NM" , name = "ConnectivityState" })
-- throws : True
-- Skip return : False

foreign import ccall "nm_client_check_connectivity_finish" nm_client_check_connectivity_finish :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CUInt

-- | Retrieves the result of an 'GI.NM.Objects.Client.clientCheckConnectivityAsync'
-- call.
clientCheckConnectivityFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@client@/: an t'GI.NM.Objects.Client.Client'
    -> b
    -- ^ /@result@/: the t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m NM.Enums.ConnectivityState
    -- ^ __Returns:__ the (new) current connectivity state /(Can throw 'Data.GI.Base.GError.GError')/
clientCheckConnectivityFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsClient a, IsAsyncResult b) =>
a -> b -> m ConnectivityState
clientCheckConnectivityFinish a
client b
result_ = IO ConnectivityState -> m ConnectivityState
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ConnectivityState -> m ConnectivityState)
-> IO ConnectivityState -> m ConnectivityState
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO ConnectivityState -> IO () -> IO ConnectivityState
forall a b. IO a -> IO b -> IO a
onException (do
        CUInt
result <- (Ptr (Ptr GError) -> IO CUInt) -> IO CUInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CUInt) -> IO CUInt)
-> (Ptr (Ptr GError) -> IO CUInt) -> IO CUInt
forall a b. (a -> b) -> a -> b
$ Ptr Client -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CUInt
nm_client_check_connectivity_finish Ptr Client
client' Ptr AsyncResult
result_'
        let result' :: ConnectivityState
result' = (Int -> ConnectivityState
forall a. Enum a => Int -> a
toEnum (Int -> ConnectivityState)
-> (CUInt -> Int) -> CUInt -> ConnectivityState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        ConnectivityState -> IO ConnectivityState
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ConnectivityState
result'
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data ClientCheckConnectivityFinishMethodInfo
instance (signature ~ (b -> m NM.Enums.ConnectivityState), MonadIO m, IsClient a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod ClientCheckConnectivityFinishMethodInfo a signature where
    overloadedMethod = clientCheckConnectivityFinish

instance O.OverloadedMethodInfo ClientCheckConnectivityFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientCheckConnectivityFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientCheckConnectivityFinish"
        })


#endif

-- method Client::checkpoint_adjust_rollback_timeout
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the %NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "checkpoint_path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a D-Bus path to a checkpoint"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "add_timeout"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the timeout in seconds counting from now.\n  Set to zero, to disable the timeout."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "callback to be called when the add operation completes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "caller-specific data passed to @callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_checkpoint_adjust_rollback_timeout" nm_client_checkpoint_adjust_rollback_timeout :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    CString ->                              -- checkpoint_path : TBasicType TUTF8
    Word32 ->                               -- add_timeout : TBasicType TUInt32
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Resets the timeout for the checkpoint with path /@checkpointPath@/
-- to /@timeoutAdd@/.
-- 
-- /Since: 1.12/
clientCheckpointAdjustRollbackTimeout ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@client@/: the @/NMClient/@
    -> T.Text
    -- ^ /@checkpointPath@/: a D-Bus path to a checkpoint
    -> Word32
    -- ^ /@addTimeout@/: the timeout in seconds counting from now.
    --   Set to zero, to disable the timeout.
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: callback to be called when the add operation completes
    -> m ()
clientCheckpointAdjustRollbackTimeout :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsClient a, IsCancellable b) =>
a -> Text -> Word32 -> Maybe b -> Maybe AsyncReadyCallback -> m ()
clientCheckpointAdjustRollbackTimeout a
client Text
checkpointPath Word32
addTimeout Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr CChar
checkpointPath' <- Text -> IO (Ptr CChar)
textToCString Text
checkpointPath
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Client
-> Ptr CChar
-> Word32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
nm_client_checkpoint_adjust_rollback_timeout Ptr Client
client' Ptr CChar
checkpointPath' Word32
addTimeout Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
checkpointPath'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ClientCheckpointAdjustRollbackTimeoutMethodInfo
instance (signature ~ (T.Text -> Word32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsClient a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod ClientCheckpointAdjustRollbackTimeoutMethodInfo a signature where
    overloadedMethod = clientCheckpointAdjustRollbackTimeout

instance O.OverloadedMethodInfo ClientCheckpointAdjustRollbackTimeoutMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientCheckpointAdjustRollbackTimeout",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientCheckpointAdjustRollbackTimeout"
        })


#endif

-- method Client::checkpoint_adjust_rollback_timeout_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the result passed to the #GAsyncReadyCallback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "nm_client_checkpoint_adjust_rollback_timeout_finish" nm_client_checkpoint_adjust_rollback_timeout_finish :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Gets the result of a call to 'GI.NM.Objects.Client.clientCheckpointAdjustRollbackTimeout'.
-- 
-- /Since: 1.12/
clientCheckpointAdjustRollbackTimeoutFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@client@/: an t'GI.NM.Objects.Client.Client'
    -> b
    -- ^ /@result@/: the result passed to the t'GI.Gio.Callbacks.AsyncReadyCallback'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
clientCheckpointAdjustRollbackTimeoutFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsClient a, IsAsyncResult b) =>
a -> b -> m ()
clientCheckpointAdjustRollbackTimeoutFinish a
client b
result_ = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Client -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
nm_client_checkpoint_adjust_rollback_timeout_finish Ptr Client
client' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data ClientCheckpointAdjustRollbackTimeoutFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsClient a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod ClientCheckpointAdjustRollbackTimeoutFinishMethodInfo a signature where
    overloadedMethod = clientCheckpointAdjustRollbackTimeoutFinish

instance O.OverloadedMethodInfo ClientCheckpointAdjustRollbackTimeoutFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientCheckpointAdjustRollbackTimeoutFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientCheckpointAdjustRollbackTimeoutFinish"
        })


#endif

-- method Client::checkpoint_create
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the %NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "devices"
--           , argType =
--               TPtrArray (TInterface Name { namespace = "NM" , name = "Device" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a list of devices for which a\n  checkpoint should be created."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "rollback_timeout"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the rollback timeout in seconds"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "NM" , name = "CheckpointCreateFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "creation flags" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "callback to be called when the add operation completes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 6
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "caller-specific data passed to @callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_checkpoint_create" nm_client_checkpoint_create :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    Ptr (GPtrArray (Ptr NM.Device.Device)) -> -- devices : TPtrArray (TInterface (Name {namespace = "NM", name = "Device"}))
    Word32 ->                               -- rollback_timeout : TBasicType TUInt32
    CUInt ->                                -- flags : TInterface (Name {namespace = "NM", name = "CheckpointCreateFlags"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Creates a checkpoint of the current networking configuration
-- for given interfaces. An empty /@devices@/ argument means all
-- devices. If /@rollbackTimeout@/ is not zero, a rollback is
-- automatically performed after the given timeout.
-- 
-- /Since: 1.12/
clientCheckpointCreate ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@client@/: the @/NMClient/@
    -> [NM.Device.Device]
    -- ^ /@devices@/: a list of devices for which a
    --   checkpoint should be created.
    -> Word32
    -- ^ /@rollbackTimeout@/: the rollback timeout in seconds
    -> [NM.Flags.CheckpointCreateFlags]
    -- ^ /@flags@/: creation flags
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: callback to be called when the add operation completes
    -> m ()
clientCheckpointCreate :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsClient a, IsCancellable b) =>
a
-> [Device]
-> Word32
-> [CheckpointCreateFlags]
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
clientCheckpointCreate a
client [Device]
devices Word32
rollbackTimeout [CheckpointCreateFlags]
flags Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    [Ptr Device]
devices' <- (Device -> IO (Ptr Device)) -> [Device] -> IO [Ptr Device]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Device -> IO (Ptr Device)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr [Device]
devices
    Ptr (GPtrArray (Ptr Device))
devices'' <- [Ptr Device] -> IO (Ptr (GPtrArray (Ptr Device)))
forall a. [Ptr a] -> IO (Ptr (GPtrArray (Ptr a)))
packGPtrArray [Ptr Device]
devices'
    let flags' :: CUInt
flags' = [CheckpointCreateFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [CheckpointCreateFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Client
-> Ptr (GPtrArray (Ptr Device))
-> Word32
-> CUInt
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
nm_client_checkpoint_create Ptr Client
client' Ptr (GPtrArray (Ptr Device))
devices'' Word32
rollbackTimeout CUInt
flags' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    ClientAnyDeviceAddedCallback -> [Device] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ClientAnyDeviceAddedCallback
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [Device]
devices
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Ptr (GPtrArray (Ptr Device)) -> IO ()
forall a. Ptr (GPtrArray a) -> IO ()
unrefPtrArray Ptr (GPtrArray (Ptr Device))
devices''
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ClientCheckpointCreateMethodInfo
instance (signature ~ ([NM.Device.Device] -> Word32 -> [NM.Flags.CheckpointCreateFlags] -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsClient a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod ClientCheckpointCreateMethodInfo a signature where
    overloadedMethod = clientCheckpointCreate

instance O.OverloadedMethodInfo ClientCheckpointCreateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientCheckpointCreate",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientCheckpointCreate"
        })


#endif

-- method Client::checkpoint_create_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the result passed to the #GAsyncReadyCallback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "NM" , name = "Checkpoint" })
-- throws : True
-- Skip return : False

foreign import ccall "nm_client_checkpoint_create_finish" nm_client_checkpoint_create_finish :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr NM.Checkpoint.Checkpoint)

-- | Gets the result of a call to 'GI.NM.Objects.Client.clientCheckpointCreate'.
-- 
-- /Since: 1.12/
clientCheckpointCreateFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@client@/: the t'GI.NM.Objects.Client.Client'
    -> b
    -- ^ /@result@/: the result passed to the t'GI.Gio.Callbacks.AsyncReadyCallback'
    -> m NM.Checkpoint.Checkpoint
    -- ^ __Returns:__ the new t'GI.NM.Objects.Checkpoint.Checkpoint' on success, 'P.Nothing' on
    --   failure, in which case /@error@/ will be set. /(Can throw 'Data.GI.Base.GError.GError')/
clientCheckpointCreateFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsClient a, IsAsyncResult b) =>
a -> b -> m Checkpoint
clientCheckpointCreateFinish a
client b
result_ = IO Checkpoint -> m Checkpoint
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Checkpoint -> m Checkpoint) -> IO Checkpoint -> m Checkpoint
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO Checkpoint -> IO () -> IO Checkpoint
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Checkpoint
result <- (Ptr (Ptr GError) -> IO (Ptr Checkpoint)) -> IO (Ptr Checkpoint)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Checkpoint)) -> IO (Ptr Checkpoint))
-> (Ptr (Ptr GError) -> IO (Ptr Checkpoint)) -> IO (Ptr Checkpoint)
forall a b. (a -> b) -> a -> b
$ Ptr Client
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr Checkpoint)
nm_client_checkpoint_create_finish Ptr Client
client' Ptr AsyncResult
result_'
        Text -> Ptr Checkpoint -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"clientCheckpointCreateFinish" Ptr Checkpoint
result
        Checkpoint
result' <- ((ManagedPtr Checkpoint -> Checkpoint)
-> Ptr Checkpoint -> IO Checkpoint
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Checkpoint -> Checkpoint
NM.Checkpoint.Checkpoint) Ptr Checkpoint
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        Checkpoint -> IO Checkpoint
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Checkpoint
result'
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data ClientCheckpointCreateFinishMethodInfo
instance (signature ~ (b -> m NM.Checkpoint.Checkpoint), MonadIO m, IsClient a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod ClientCheckpointCreateFinishMethodInfo a signature where
    overloadedMethod = clientCheckpointCreateFinish

instance O.OverloadedMethodInfo ClientCheckpointCreateFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientCheckpointCreateFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientCheckpointCreateFinish"
        })


#endif

-- method Client::checkpoint_destroy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the %NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "checkpoint_path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the D-Bus path for the checkpoint"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "callback to be called when the add operation completes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 4
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "caller-specific data passed to @callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_checkpoint_destroy" nm_client_checkpoint_destroy :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    CString ->                              -- checkpoint_path : TBasicType TUTF8
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Destroys an existing checkpoint without performing a rollback.
-- 
-- /Since: 1.12/
clientCheckpointDestroy ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@client@/: the @/NMClient/@
    -> T.Text
    -- ^ /@checkpointPath@/: the D-Bus path for the checkpoint
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: callback to be called when the add operation completes
    -> m ()
clientCheckpointDestroy :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsClient a, IsCancellable b) =>
a -> Text -> Maybe b -> Maybe AsyncReadyCallback -> m ()
clientCheckpointDestroy a
client Text
checkpointPath Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr CChar
checkpointPath' <- Text -> IO (Ptr CChar)
textToCString Text
checkpointPath
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Client
-> Ptr CChar
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
nm_client_checkpoint_destroy Ptr Client
client' Ptr CChar
checkpointPath' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
checkpointPath'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ClientCheckpointDestroyMethodInfo
instance (signature ~ (T.Text -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsClient a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod ClientCheckpointDestroyMethodInfo a signature where
    overloadedMethod = clientCheckpointDestroy

instance O.OverloadedMethodInfo ClientCheckpointDestroyMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientCheckpointDestroy",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientCheckpointDestroy"
        })


#endif

-- method Client::checkpoint_destroy_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the result passed to the #GAsyncReadyCallback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "nm_client_checkpoint_destroy_finish" nm_client_checkpoint_destroy_finish :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Gets the result of a call to 'GI.NM.Objects.Client.clientCheckpointDestroy'.
-- 
-- /Since: 1.12/
clientCheckpointDestroyFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@client@/: an t'GI.NM.Objects.Client.Client'
    -> b
    -- ^ /@result@/: the result passed to the t'GI.Gio.Callbacks.AsyncReadyCallback'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
clientCheckpointDestroyFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsClient a, IsAsyncResult b) =>
a -> b -> m ()
clientCheckpointDestroyFinish a
client b
result_ = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Client -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
nm_client_checkpoint_destroy_finish Ptr Client
client' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data ClientCheckpointDestroyFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsClient a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod ClientCheckpointDestroyFinishMethodInfo a signature where
    overloadedMethod = clientCheckpointDestroyFinish

instance O.OverloadedMethodInfo ClientCheckpointDestroyFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientCheckpointDestroyFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientCheckpointDestroyFinish"
        })


#endif

-- method Client::checkpoint_rollback
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the %NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "checkpoint_path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the D-Bus path to the checkpoint"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "callback to be called when the add operation completes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 4
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "caller-specific data passed to @callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_checkpoint_rollback" nm_client_checkpoint_rollback :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    CString ->                              -- checkpoint_path : TBasicType TUTF8
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Performs the rollback of a checkpoint before the timeout is reached.
-- 
-- /Since: 1.12/
clientCheckpointRollback ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@client@/: the @/NMClient/@
    -> T.Text
    -- ^ /@checkpointPath@/: the D-Bus path to the checkpoint
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: callback to be called when the add operation completes
    -> m ()
clientCheckpointRollback :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsClient a, IsCancellable b) =>
a -> Text -> Maybe b -> Maybe AsyncReadyCallback -> m ()
clientCheckpointRollback a
client Text
checkpointPath Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr CChar
checkpointPath' <- Text -> IO (Ptr CChar)
textToCString Text
checkpointPath
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Client
-> Ptr CChar
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
nm_client_checkpoint_rollback Ptr Client
client' Ptr CChar
checkpointPath' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
checkpointPath'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ClientCheckpointRollbackMethodInfo
instance (signature ~ (T.Text -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsClient a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod ClientCheckpointRollbackMethodInfo a signature where
    overloadedMethod = clientCheckpointRollback

instance O.OverloadedMethodInfo ClientCheckpointRollbackMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientCheckpointRollback",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientCheckpointRollback"
        })


#endif

-- XXX Could not generate method Client::checkpoint_rollback_finish
-- Not implemented: GHashTable element of type TBasicType TUInt32 unsupported.
#if defined(ENABLE_OVERLOADING)
-- XXX: Dummy instance, since code generation failed.
-- Please file a bug at http://github.com/haskell-gi/haskell-gi.
data ClientCheckpointRollbackFinishMethodInfo
instance (p ~ (), o ~ O.UnsupportedMethodError "checkpointRollbackFinish" Client) => O.OverloadedMethod ClientCheckpointRollbackFinishMethodInfo o p where
    overloadedMethod = undefined

instance (o ~ O.UnsupportedMethodError "checkpointRollbackFinish" Client) => O.OverloadedMethodInfo ClientCheckpointRollbackFinishMethodInfo o where
    overloadedMethodInfo = undefined

#endif

-- method Client::connectivity_check_get_available
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_connectivity_check_get_available" nm_client_connectivity_check_get_available :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    IO CInt

-- | Determine whether connectivity checking is available.  This
-- requires that the URI of a connectivity service has been set in the
-- configuration file.
-- 
-- /Since: 1.10/
clientConnectivityCheckGetAvailable ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a) =>
    a
    -- ^ /@client@/: a t'GI.NM.Objects.Client.Client'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if connectivity checking is available.
clientConnectivityCheckGetAvailable :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClient a) =>
a -> m Bool
clientConnectivityCheckGetAvailable a
client = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    CInt
result <- Ptr Client -> IO CInt
nm_client_connectivity_check_get_available Ptr Client
client'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ClientConnectivityCheckGetAvailableMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsClient a) => O.OverloadedMethod ClientConnectivityCheckGetAvailableMethodInfo a signature where
    overloadedMethod = clientConnectivityCheckGetAvailable

instance O.OverloadedMethodInfo ClientConnectivityCheckGetAvailableMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientConnectivityCheckGetAvailable",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientConnectivityCheckGetAvailable"
        })


#endif

-- method Client::connectivity_check_get_enabled
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_connectivity_check_get_enabled" nm_client_connectivity_check_get_enabled :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    IO CInt

-- | Determine whether connectivity checking is enabled.
-- 
-- /Since: 1.10/
clientConnectivityCheckGetEnabled ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a) =>
    a
    -- ^ /@client@/: a t'GI.NM.Objects.Client.Client'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if connectivity checking is enabled.
clientConnectivityCheckGetEnabled :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClient a) =>
a -> m Bool
clientConnectivityCheckGetEnabled a
client = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    CInt
result <- Ptr Client -> IO CInt
nm_client_connectivity_check_get_enabled Ptr Client
client'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ClientConnectivityCheckGetEnabledMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsClient a) => O.OverloadedMethod ClientConnectivityCheckGetEnabledMethodInfo a signature where
    overloadedMethod = clientConnectivityCheckGetEnabled

instance O.OverloadedMethodInfo ClientConnectivityCheckGetEnabledMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientConnectivityCheckGetEnabled",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientConnectivityCheckGetEnabled"
        })


#endif

-- method Client::connectivity_check_get_uri
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_connectivity_check_get_uri" nm_client_connectivity_check_get_uri :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    IO CString

-- | Get the URI that will be queried to determine if there is internet
-- connectivity.
-- 
-- /Since: 1.20/
clientConnectivityCheckGetUri ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a) =>
    a
    -- ^ /@client@/: a t'GI.NM.Objects.Client.Client'
    -> m T.Text
    -- ^ __Returns:__ the connectivity URI in use
clientConnectivityCheckGetUri :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClient a) =>
a -> m Text
clientConnectivityCheckGetUri a
client = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr CChar
result <- Ptr Client -> IO (Ptr CChar)
nm_client_connectivity_check_get_uri Ptr Client
client'
    Text -> Ptr CChar -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"clientConnectivityCheckGetUri" Ptr CChar
result
    Text
result' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data ClientConnectivityCheckGetUriMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsClient a) => O.OverloadedMethod ClientConnectivityCheckGetUriMethodInfo a signature where
    overloadedMethod = clientConnectivityCheckGetUri

instance O.OverloadedMethodInfo ClientConnectivityCheckGetUriMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientConnectivityCheckGetUri",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientConnectivityCheckGetUri"
        })


#endif

-- method Client::connectivity_check_set_enabled
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "enabled"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE to enable connectivity checking"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_connectivity_check_set_enabled" nm_client_connectivity_check_set_enabled :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    CInt ->                                 -- enabled : TBasicType TBoolean
    IO ()

{-# DEPRECATED clientConnectivityCheckSetEnabled ["(Since version 1.22)","Use the async command 'GI.NM.Objects.Client.clientDbusSetProperty' on 'GI.NM.Constants.DBUS_PATH',","'GI.NM.Constants.DBUS_INTERFACE' to set \\\"ConnectivityCheckEnabled\\\" property to a \\\"(b)\\\" value."] #-}
-- | Enable or disable connectivity checking.  Note that if a
-- connectivity checking URI has not been configured, this will not
-- have any effect.
-- 
-- /Since: 1.10/
clientConnectivityCheckSetEnabled ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a) =>
    a
    -- ^ /@client@/: a t'GI.NM.Objects.Client.Client'
    -> Bool
    -- ^ /@enabled@/: 'P.True' to enable connectivity checking
    -> m ()
clientConnectivityCheckSetEnabled :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClient a) =>
a -> Bool -> m ()
clientConnectivityCheckSetEnabled a
client Bool
enabled = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    let enabled' :: CInt
enabled' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
enabled
    Ptr Client -> CInt -> IO ()
nm_client_connectivity_check_set_enabled Ptr Client
client' CInt
enabled'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ClientConnectivityCheckSetEnabledMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsClient a) => O.OverloadedMethod ClientConnectivityCheckSetEnabledMethodInfo a signature where
    overloadedMethod = clientConnectivityCheckSetEnabled

instance O.OverloadedMethodInfo ClientConnectivityCheckSetEnabledMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientConnectivityCheckSetEnabled",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientConnectivityCheckSetEnabled"
        })


#endif

-- method Client::dbus_call
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "object_path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "path of remote object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "interface_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "D-Bus interface to invoke method on"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "method_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the method to invoke"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parameters"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #GVariant tuple with parameters for the method\n    or %NULL if not passing parameters"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "reply_type"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "VariantType" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the expected type of the reply (which will be a\n    tuple), or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timeout_msec"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the timeout in milliseconds, -1 to use the default\n    timeout or %G_MAXINT for no timeout"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #GAsyncReadyCallback to call when the request\n    is satisfied or %NULL if you don't care about the result of the\n    method invocation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 9
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to pass to @callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_dbus_call" nm_client_dbus_call :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    CString ->                              -- object_path : TBasicType TUTF8
    CString ->                              -- interface_name : TBasicType TUTF8
    CString ->                              -- method_name : TBasicType TUTF8
    Ptr GVariant ->                         -- parameters : TVariant
    Ptr GLib.VariantType.VariantType ->     -- reply_type : TInterface (Name {namespace = "GLib", name = "VariantType"})
    Int32 ->                                -- timeout_msec : TBasicType TInt
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Call 'GI.Gio.Objects.DBusConnection.dBusConnectionCall' on the current name owner with the specified
-- arguments. Most importantly, this invokes 'GI.Gio.Objects.DBusConnection.dBusConnectionCall' with the
-- client\'s t'GI.GLib.Structs.MainContext.MainContext', so that the response is always in order with other
-- events D-Bus events. Of course, the call uses t'GI.Gio.Objects.Task.Task' and will invoke the
-- callback on the current 'GI.GLib.Functions.mainContextGetThreadDefault'.
-- 
-- This API is merely a convenient wrapper for 'GI.Gio.Objects.DBusConnection.dBusConnectionCall'. You can
-- also use 'GI.Gio.Objects.DBusConnection.dBusConnectionCall' directly, with the same effect.
-- 
-- /Since: 1.24/
clientDbusCall ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@client@/: the t'GI.NM.Objects.Client.Client'
    -> T.Text
    -- ^ /@objectPath@/: path of remote object
    -> T.Text
    -- ^ /@interfaceName@/: D-Bus interface to invoke method on
    -> T.Text
    -- ^ /@methodName@/: the name of the method to invoke
    -> Maybe (GVariant)
    -- ^ /@parameters@/: a t'GVariant' tuple with parameters for the method
    --     or 'P.Nothing' if not passing parameters
    -> Maybe (GLib.VariantType.VariantType)
    -- ^ /@replyType@/: the expected type of the reply (which will be a
    --     tuple), or 'P.Nothing'
    -> Int32
    -- ^ /@timeoutMsec@/: the timeout in milliseconds, -1 to use the default
    --     timeout or @/G_MAXINT/@ for no timeout
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable' or 'P.Nothing'
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback' to call when the request
    --     is satisfied or 'P.Nothing' if you don\'t care about the result of the
    --     method invocation
    -> m ()
clientDbusCall :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsClient a, IsCancellable b) =>
a
-> Text
-> Text
-> Text
-> Maybe GVariant
-> Maybe VariantType
-> Int32
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
clientDbusCall a
client Text
objectPath Text
interfaceName Text
methodName Maybe GVariant
parameters Maybe VariantType
replyType Int32
timeoutMsec Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr CChar
objectPath' <- Text -> IO (Ptr CChar)
textToCString Text
objectPath
    Ptr CChar
interfaceName' <- Text -> IO (Ptr CChar)
textToCString Text
interfaceName
    Ptr CChar
methodName' <- Text -> IO (Ptr CChar)
textToCString Text
methodName
    Ptr GVariant
maybeParameters <- case Maybe GVariant
parameters of
        Maybe GVariant
Nothing -> Ptr GVariant -> IO (Ptr GVariant)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GVariant
forall a. Ptr a
FP.nullPtr
        Just GVariant
jParameters -> do
            Ptr GVariant
jParameters' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
jParameters
            Ptr GVariant -> IO (Ptr GVariant)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GVariant
jParameters'
    Ptr VariantType
maybeReplyType <- case Maybe VariantType
replyType of
        Maybe VariantType
Nothing -> Ptr VariantType -> IO (Ptr VariantType)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr VariantType
forall a. Ptr a
FP.nullPtr
        Just VariantType
jReplyType -> do
            Ptr VariantType
jReplyType' <- VariantType -> IO (Ptr VariantType)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VariantType
jReplyType
            Ptr VariantType -> IO (Ptr VariantType)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr VariantType
jReplyType'
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Client
-> Ptr CChar
-> Ptr CChar
-> Ptr CChar
-> Ptr GVariant
-> Ptr VariantType
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
nm_client_dbus_call Ptr Client
client' Ptr CChar
objectPath' Ptr CChar
interfaceName' Ptr CChar
methodName' Ptr GVariant
maybeParameters Ptr VariantType
maybeReplyType Int32
timeoutMsec Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    Maybe GVariant -> (GVariant -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe GVariant
parameters GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe VariantType -> (VariantType -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe VariantType
replyType VariantType -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
objectPath'
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
interfaceName'
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
methodName'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ClientDbusCallMethodInfo
instance (signature ~ (T.Text -> T.Text -> T.Text -> Maybe (GVariant) -> Maybe (GLib.VariantType.VariantType) -> Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsClient a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod ClientDbusCallMethodInfo a signature where
    overloadedMethod = clientDbusCall

instance O.OverloadedMethodInfo ClientDbusCallMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientDbusCall",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientDbusCall"
        })


#endif

-- method Client::dbus_call_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMClient instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the result passed to the #GAsyncReadyCallback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just TVariant
-- throws : True
-- Skip return : False

foreign import ccall "nm_client_dbus_call_finish" nm_client_dbus_call_finish :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr GVariant)

-- | Gets the result of a call to 'GI.NM.Objects.Client.clientDbusCall'.
-- 
-- /Since: 1.24/
clientDbusCallFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@client@/: the t'GI.NM.Objects.Client.Client' instance
    -> b
    -- ^ /@result@/: the result passed to the t'GI.Gio.Callbacks.AsyncReadyCallback'
    -> m GVariant
    -- ^ __Returns:__ the result t'GVariant' or 'P.Nothing' on error. /(Can throw 'Data.GI.Base.GError.GError')/
clientDbusCallFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsClient a, IsAsyncResult b) =>
a -> b -> m GVariant
clientDbusCallFinish a
client b
result_ = IO GVariant -> m GVariant
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GVariant -> m GVariant) -> IO GVariant -> m GVariant
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO GVariant -> IO () -> IO GVariant
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr GVariant
result <- (Ptr (Ptr GError) -> IO (Ptr GVariant)) -> IO (Ptr GVariant)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr GVariant)) -> IO (Ptr GVariant))
-> (Ptr (Ptr GError) -> IO (Ptr GVariant)) -> IO (Ptr GVariant)
forall a b. (a -> b) -> a -> b
$ Ptr Client
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr GVariant)
nm_client_dbus_call_finish Ptr Client
client' Ptr AsyncResult
result_'
        Text -> Ptr GVariant -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"clientDbusCallFinish" Ptr GVariant
result
        GVariant
result' <- Ptr GVariant -> IO GVariant
B.GVariant.wrapGVariantPtr Ptr GVariant
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        GVariant -> IO GVariant
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GVariant
result'
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data ClientDbusCallFinishMethodInfo
instance (signature ~ (b -> m GVariant), MonadIO m, IsClient a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod ClientDbusCallFinishMethodInfo a signature where
    overloadedMethod = clientDbusCallFinish

instance O.OverloadedMethodInfo ClientDbusCallFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientDbusCallFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientDbusCallFinish"
        })


#endif

-- method Client::dbus_set_property
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "object_path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "path of remote object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "interface_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "D-Bus interface for the property to set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the property to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GVariant with the value to set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timeout_msec"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the timeout in milliseconds, -1 to use the default\n    timeout or %G_MAXINT for no timeout"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #GAsyncReadyCallback to call when the request\n    is satisfied or %NULL if you don't care about the result of the\n    method invocation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 8
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to pass to @callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_dbus_set_property" nm_client_dbus_set_property :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    CString ->                              -- object_path : TBasicType TUTF8
    CString ->                              -- interface_name : TBasicType TUTF8
    CString ->                              -- property_name : TBasicType TUTF8
    Ptr GVariant ->                         -- value : TVariant
    Int32 ->                                -- timeout_msec : TBasicType TInt
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Like 'GI.NM.Objects.Client.clientDbusCall' but calls \"Set\" on the standard \"org.freedesktop.DBus.Properties\"
-- D-Bus interface.
-- 
-- /Since: 1.24/
clientDbusSetProperty ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@client@/: the t'GI.NM.Objects.Client.Client'
    -> T.Text
    -- ^ /@objectPath@/: path of remote object
    -> T.Text
    -- ^ /@interfaceName@/: D-Bus interface for the property to set.
    -> T.Text
    -- ^ /@propertyName@/: the name of the property to set
    -> GVariant
    -- ^ /@value@/: a t'GVariant' with the value to set.
    -> Int32
    -- ^ /@timeoutMsec@/: the timeout in milliseconds, -1 to use the default
    --     timeout or @/G_MAXINT/@ for no timeout
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable' or 'P.Nothing'
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback' to call when the request
    --     is satisfied or 'P.Nothing' if you don\'t care about the result of the
    --     method invocation
    -> m ()
clientDbusSetProperty :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsClient a, IsCancellable b) =>
a
-> Text
-> Text
-> Text
-> GVariant
-> Int32
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
clientDbusSetProperty a
client Text
objectPath Text
interfaceName Text
propertyName GVariant
value Int32
timeoutMsec Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr CChar
objectPath' <- Text -> IO (Ptr CChar)
textToCString Text
objectPath
    Ptr CChar
interfaceName' <- Text -> IO (Ptr CChar)
textToCString Text
interfaceName
    Ptr CChar
propertyName' <- Text -> IO (Ptr CChar)
textToCString Text
propertyName
    Ptr GVariant
value' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
value
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Client
-> Ptr CChar
-> Ptr CChar
-> Ptr CChar
-> Ptr GVariant
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
nm_client_dbus_set_property Ptr Client
client' Ptr CChar
objectPath' Ptr CChar
interfaceName' Ptr CChar
propertyName' Ptr GVariant
value' Int32
timeoutMsec Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GVariant
value
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
objectPath'
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
interfaceName'
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
propertyName'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ClientDbusSetPropertyMethodInfo
instance (signature ~ (T.Text -> T.Text -> T.Text -> GVariant -> Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsClient a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod ClientDbusSetPropertyMethodInfo a signature where
    overloadedMethod = clientDbusSetProperty

instance O.OverloadedMethodInfo ClientDbusSetPropertyMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientDbusSetProperty",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientDbusSetProperty"
        })


#endif

-- method Client::dbus_set_property_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMClient instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the result passed to the #GAsyncReadyCallback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "nm_client_dbus_set_property_finish" nm_client_dbus_set_property_finish :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Gets the result of a call to 'GI.NM.Objects.Client.clientDbusSetProperty'.
-- 
-- /Since: 1.24/
clientDbusSetPropertyFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@client@/: the t'GI.NM.Objects.Client.Client' instance
    -> b
    -- ^ /@result@/: the result passed to the t'GI.Gio.Callbacks.AsyncReadyCallback'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
clientDbusSetPropertyFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsClient a, IsAsyncResult b) =>
a -> b -> m ()
clientDbusSetPropertyFinish a
client b
result_ = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Client -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
nm_client_dbus_set_property_finish Ptr Client
client' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data ClientDbusSetPropertyFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsClient a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod ClientDbusSetPropertyFinishMethodInfo a signature where
    overloadedMethod = clientDbusSetPropertyFinish

instance O.OverloadedMethodInfo ClientDbusSetPropertyFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientDbusSetPropertyFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientDbusSetPropertyFinish"
        })


#endif

-- method Client::deactivate_connection
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "active"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "ActiveConnection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMActiveConnection to deactivate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "nm_client_deactivate_connection" nm_client_deactivate_connection :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    Ptr NM.ActiveConnection.ActiveConnection -> -- active : TInterface (Name {namespace = "NM", name = "ActiveConnection"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

{-# DEPRECATED clientDeactivateConnection ["(Since version 1.22)","Use 'GI.NM.Objects.Client.clientDeactivateConnectionAsync' or GDBusConnection."] #-}
-- | Deactivates an active t'GI.NM.Objects.ActiveConnection.ActiveConnection'.
clientDeactivateConnection ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a, NM.ActiveConnection.IsActiveConnection b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@client@/: a t'GI.NM.Objects.Client.Client'
    -> b
    -- ^ /@active@/: the t'GI.NM.Objects.ActiveConnection.ActiveConnection' to deactivate
    -> Maybe (c)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
clientDeactivateConnection :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsClient a, IsActiveConnection b,
 IsCancellable c) =>
a -> b -> Maybe c -> m ()
clientDeactivateConnection a
client b
active Maybe c
cancellable = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr ActiveConnection
active' <- b -> IO (Ptr ActiveConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
active
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Client
-> Ptr ActiveConnection
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
nm_client_deactivate_connection Ptr Client
client' Ptr ActiveConnection
active' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
active
        Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data ClientDeactivateConnectionMethodInfo
instance (signature ~ (b -> Maybe (c) -> m ()), MonadIO m, IsClient a, NM.ActiveConnection.IsActiveConnection b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod ClientDeactivateConnectionMethodInfo a signature where
    overloadedMethod = clientDeactivateConnection

instance O.OverloadedMethodInfo ClientDeactivateConnectionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientDeactivateConnection",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientDeactivateConnection"
        })


#endif

-- method Client::deactivate_connection_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "active"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "ActiveConnection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMActiveConnection to deactivate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "callback to be called when the deactivation has completed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 4
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "caller-specific data passed to @callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_deactivate_connection_async" nm_client_deactivate_connection_async :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    Ptr NM.ActiveConnection.ActiveConnection -> -- active : TInterface (Name {namespace = "NM", name = "ActiveConnection"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Asynchronously deactivates an active t'GI.NM.Objects.ActiveConnection.ActiveConnection'.
clientDeactivateConnectionAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a, NM.ActiveConnection.IsActiveConnection b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@client@/: a t'GI.NM.Objects.Client.Client'
    -> b
    -- ^ /@active@/: the t'GI.NM.Objects.ActiveConnection.ActiveConnection' to deactivate
    -> Maybe (c)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: callback to be called when the deactivation has completed
    -> m ()
clientDeactivateConnectionAsync :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsClient a, IsActiveConnection b,
 IsCancellable c) =>
a -> b -> Maybe c -> Maybe AsyncReadyCallback -> m ()
clientDeactivateConnectionAsync a
client b
active Maybe c
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr ActiveConnection
active' <- b -> IO (Ptr ActiveConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
active
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Client
-> Ptr ActiveConnection
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
nm_client_deactivate_connection_async Ptr Client
client' Ptr ActiveConnection
active' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
active
    Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ClientDeactivateConnectionAsyncMethodInfo
instance (signature ~ (b -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsClient a, NM.ActiveConnection.IsActiveConnection b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod ClientDeactivateConnectionAsyncMethodInfo a signature where
    overloadedMethod = clientDeactivateConnectionAsync

instance O.OverloadedMethodInfo ClientDeactivateConnectionAsyncMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientDeactivateConnectionAsync",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientDeactivateConnectionAsync"
        })


#endif

-- method Client::deactivate_connection_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the result passed to the #GAsyncReadyCallback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "nm_client_deactivate_connection_finish" nm_client_deactivate_connection_finish :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Gets the result of a call to 'GI.NM.Objects.Client.clientDeactivateConnectionAsync'.
clientDeactivateConnectionFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@client@/: a t'GI.NM.Objects.Client.Client'
    -> b
    -- ^ /@result@/: the result passed to the t'GI.Gio.Callbacks.AsyncReadyCallback'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
clientDeactivateConnectionFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsClient a, IsAsyncResult b) =>
a -> b -> m ()
clientDeactivateConnectionFinish a
client b
result_ = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Client -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
nm_client_deactivate_connection_finish Ptr Client
client' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data ClientDeactivateConnectionFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsClient a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod ClientDeactivateConnectionFinishMethodInfo a signature where
    overloadedMethod = clientDeactivateConnectionFinish

instance O.OverloadedMethodInfo ClientDeactivateConnectionFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientDeactivateConnectionFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientDeactivateConnectionFinish"
        })


#endif

-- method Client::get_activating_connection
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "NM" , name = "ActiveConnection" })
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_get_activating_connection" nm_client_get_activating_connection :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    IO (Ptr NM.ActiveConnection.ActiveConnection)

-- | Gets the t'GI.NM.Objects.ActiveConnection.ActiveConnection' corresponding to a
-- currently-activating connection that is expected to become the new
-- [Client:primaryConnection]("GI.NM.Objects.Client#g:attr:primaryConnection") upon successful activation.
clientGetActivatingConnection ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a) =>
    a
    -- ^ /@client@/: an t'GI.NM.Objects.Client.Client'
    -> m NM.ActiveConnection.ActiveConnection
    -- ^ __Returns:__ the appropriate t'GI.NM.Objects.ActiveConnection.ActiveConnection', if
    -- any.
clientGetActivatingConnection :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClient a) =>
a -> m ActiveConnection
clientGetActivatingConnection a
client = IO ActiveConnection -> m ActiveConnection
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ActiveConnection -> m ActiveConnection)
-> IO ActiveConnection -> m ActiveConnection
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr ActiveConnection
result <- Ptr Client -> IO (Ptr ActiveConnection)
nm_client_get_activating_connection Ptr Client
client'
    Text -> Ptr ActiveConnection -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"clientGetActivatingConnection" Ptr ActiveConnection
result
    ActiveConnection
result' <- ((ManagedPtr ActiveConnection -> ActiveConnection)
-> Ptr ActiveConnection -> IO ActiveConnection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ActiveConnection -> ActiveConnection
NM.ActiveConnection.ActiveConnection) Ptr ActiveConnection
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    ActiveConnection -> IO ActiveConnection
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ActiveConnection
result'

#if defined(ENABLE_OVERLOADING)
data ClientGetActivatingConnectionMethodInfo
instance (signature ~ (m NM.ActiveConnection.ActiveConnection), MonadIO m, IsClient a) => O.OverloadedMethod ClientGetActivatingConnectionMethodInfo a signature where
    overloadedMethod = clientGetActivatingConnection

instance O.OverloadedMethodInfo ClientGetActivatingConnectionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientGetActivatingConnection",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientGetActivatingConnection"
        })


#endif

-- method Client::get_active_connections
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TPtrArray
--                  (TInterface Name { namespace = "NM" , name = "ActiveConnection" }))
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_get_active_connections" nm_client_get_active_connections :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    IO (Ptr (GPtrArray (Ptr NM.ActiveConnection.ActiveConnection)))

-- | Gets the active connections.
clientGetActiveConnections ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a) =>
    a
    -- ^ /@client@/: a t'GI.NM.Objects.Client.Client'
    -> m [NM.ActiveConnection.ActiveConnection]
    -- ^ __Returns:__ a t'GI.GLib.Structs.PtrArray.PtrArray'
    --  containing all the active @/NMActiveConnections/@.
    -- The returned array is owned by the client and should not be modified.
clientGetActiveConnections :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClient a) =>
a -> m [ActiveConnection]
clientGetActiveConnections a
client = IO [ActiveConnection] -> m [ActiveConnection]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ActiveConnection] -> m [ActiveConnection])
-> IO [ActiveConnection] -> m [ActiveConnection]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr (GPtrArray (Ptr ActiveConnection))
result <- Ptr Client -> IO (Ptr (GPtrArray (Ptr ActiveConnection)))
nm_client_get_active_connections Ptr Client
client'
    Text -> Ptr (GPtrArray (Ptr ActiveConnection)) -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"clientGetActiveConnections" Ptr (GPtrArray (Ptr ActiveConnection))
result
    [Ptr ActiveConnection]
result' <- Ptr (GPtrArray (Ptr ActiveConnection)) -> IO [Ptr ActiveConnection]
forall a. Ptr (GPtrArray (Ptr a)) -> IO [Ptr a]
unpackGPtrArray Ptr (GPtrArray (Ptr ActiveConnection))
result
    [ActiveConnection]
result'' <- (Ptr ActiveConnection -> IO ActiveConnection)
-> [Ptr ActiveConnection] -> IO [ActiveConnection]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ManagedPtr ActiveConnection -> ActiveConnection)
-> Ptr ActiveConnection -> IO ActiveConnection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ActiveConnection -> ActiveConnection
NM.ActiveConnection.ActiveConnection) [Ptr ActiveConnection]
result'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    [ActiveConnection] -> IO [ActiveConnection]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [ActiveConnection]
result''

#if defined(ENABLE_OVERLOADING)
data ClientGetActiveConnectionsMethodInfo
instance (signature ~ (m [NM.ActiveConnection.ActiveConnection]), MonadIO m, IsClient a) => O.OverloadedMethod ClientGetActiveConnectionsMethodInfo a signature where
    overloadedMethod = clientGetActiveConnections

instance O.OverloadedMethodInfo ClientGetActiveConnectionsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientGetActiveConnections",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientGetActiveConnections"
        })


#endif

-- method Client::get_all_devices
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TPtrArray
--                  (TInterface Name { namespace = "NM" , name = "Device" }))
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_get_all_devices" nm_client_get_all_devices :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    IO (Ptr (GPtrArray (Ptr NM.Device.Device)))

-- | Gets both real devices and device placeholders (eg, software devices which
-- do not currently exist, but could be created automatically by NetworkManager
-- if one of their NMDevice[ActivatableConnections](#g:signal:ActivatableConnections) was activated).  Use
-- 'GI.NM.Objects.Device.deviceIsReal' to determine whether each device is a real device or
-- a placeholder.
-- 
-- Use @/nm_device_get_type()/@ or the @/NM_IS_DEVICE_XXXX()/@ functions to determine
-- what kind of device each member of the returned array is, and then you may
-- use device-specific methods such as @/nm_device_ethernet_get_hw_address()/@.
-- 
-- /Since: 1.2/
clientGetAllDevices ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a) =>
    a
    -- ^ /@client@/: a t'GI.NM.Objects.Client.Client'
    -> m [NM.Device.Device]
    -- ^ __Returns:__ a t'GI.GLib.Structs.PtrArray.PtrArray'
    -- containing all the @/NMDevices/@.  The returned array is owned by the
    -- t'GI.NM.Objects.Client.Client' object and should not be modified.
clientGetAllDevices :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClient a) =>
a -> m [Device]
clientGetAllDevices a
client = IO [Device] -> m [Device]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Device] -> m [Device]) -> IO [Device] -> m [Device]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr (GPtrArray (Ptr Device))
result <- Ptr Client -> IO (Ptr (GPtrArray (Ptr Device)))
nm_client_get_all_devices Ptr Client
client'
    Text -> Ptr (GPtrArray (Ptr Device)) -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"clientGetAllDevices" Ptr (GPtrArray (Ptr Device))
result
    [Ptr Device]
result' <- Ptr (GPtrArray (Ptr Device)) -> IO [Ptr Device]
forall a. Ptr (GPtrArray (Ptr a)) -> IO [Ptr a]
unpackGPtrArray Ptr (GPtrArray (Ptr Device))
result
    [Device]
result'' <- (Ptr Device -> IO Device) -> [Ptr Device] -> IO [Device]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ManagedPtr Device -> Device) -> Ptr Device -> IO Device
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Device -> Device
NM.Device.Device) [Ptr Device]
result'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    [Device] -> IO [Device]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Device]
result''

#if defined(ENABLE_OVERLOADING)
data ClientGetAllDevicesMethodInfo
instance (signature ~ (m [NM.Device.Device]), MonadIO m, IsClient a) => O.OverloadedMethod ClientGetAllDevicesMethodInfo a signature where
    overloadedMethod = clientGetAllDevices

instance O.OverloadedMethodInfo ClientGetAllDevicesMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientGetAllDevices",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientGetAllDevices"
        })


#endif

-- method Client::get_capabilities
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMClient instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TSize
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of returned capabilities."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "length"
--              , argType = TBasicType TSize
--              , direction = DirectionOut
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the number of returned capabilities."
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , argCallbackUserData = False
--              , transfer = TransferEverything
--              }
--          ]
-- returnType: Just (TCArray False (-1) 1 (TBasicType TUInt32))
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_get_capabilities" nm_client_get_capabilities :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    Ptr FCT.CSize ->                        -- length : TBasicType TSize
    IO (Ptr Word32)

-- | /No description available in the introspection data./
-- 
-- /Since: 1.24/
clientGetCapabilities ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a) =>
    a
    -- ^ /@client@/: the t'GI.NM.Objects.Client.Client' instance
    -> m [Word32]
    -- ^ __Returns:__ the
    --   list of capabilities reported by the server or 'P.Nothing'
    --   if the capabilities are unknown.
    --   The numeric values correspond to t'GI.NM.Enums.Capability' enum.
    --   The array is terminated by a numeric zero sentinel
    --   at position /@length@/.
clientGetCapabilities :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClient a) =>
a -> m [Word32]
clientGetCapabilities a
client = IO [Word32] -> m [Word32]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Word32] -> m [Word32]) -> IO [Word32] -> m [Word32]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr CSize
length_ <- IO (Ptr CSize)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr FCT.CSize)
    Ptr Word32
result <- Ptr Client -> Ptr CSize -> IO (Ptr Word32)
nm_client_get_capabilities Ptr Client
client' Ptr CSize
length_
    CSize
length_' <- Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
length_
    Text -> Ptr Word32 -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"clientGetCapabilities" Ptr Word32
result
    [Word32]
result' <- (CSize -> Ptr Word32 -> IO [Word32]
forall a b. (Integral a, Storable b) => a -> Ptr b -> IO [b]
unpackStorableArrayWithLength CSize
length_') Ptr Word32
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    Ptr CSize -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CSize
length_
    [Word32] -> IO [Word32]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Word32]
result'

#if defined(ENABLE_OVERLOADING)
data ClientGetCapabilitiesMethodInfo
instance (signature ~ (m [Word32]), MonadIO m, IsClient a) => O.OverloadedMethod ClientGetCapabilitiesMethodInfo a signature where
    overloadedMethod = clientGetCapabilities

instance O.OverloadedMethodInfo ClientGetCapabilitiesMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientGetCapabilities",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientGetCapabilities"
        })


#endif

-- method Client::get_checkpoints
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TPtrArray
--                  (TInterface Name { namespace = "NM" , name = "Checkpoint" }))
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_get_checkpoints" nm_client_get_checkpoints :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    IO (Ptr (GPtrArray (Ptr NM.Checkpoint.Checkpoint)))

-- | Gets all the active checkpoints.
-- 
-- /Since: 1.12/
clientGetCheckpoints ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a) =>
    a
    -- ^ /@client@/: a t'GI.NM.Objects.Client.Client'
    -> m [NM.Checkpoint.Checkpoint]
    -- ^ __Returns:__ a t'GI.GLib.Structs.PtrArray.PtrArray'
    -- containing all the t'GI.NM.Objects.Checkpoint.Checkpoint'.  The returned array is owned by the
    -- t'GI.NM.Objects.Client.Client' object and should not be modified.
clientGetCheckpoints :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClient a) =>
a -> m [Checkpoint]
clientGetCheckpoints a
client = IO [Checkpoint] -> m [Checkpoint]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Checkpoint] -> m [Checkpoint])
-> IO [Checkpoint] -> m [Checkpoint]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr (GPtrArray (Ptr Checkpoint))
result <- Ptr Client -> IO (Ptr (GPtrArray (Ptr Checkpoint)))
nm_client_get_checkpoints Ptr Client
client'
    Text -> Ptr (GPtrArray (Ptr Checkpoint)) -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"clientGetCheckpoints" Ptr (GPtrArray (Ptr Checkpoint))
result
    [Ptr Checkpoint]
result' <- Ptr (GPtrArray (Ptr Checkpoint)) -> IO [Ptr Checkpoint]
forall a. Ptr (GPtrArray (Ptr a)) -> IO [Ptr a]
unpackGPtrArray Ptr (GPtrArray (Ptr Checkpoint))
result
    [Checkpoint]
result'' <- (Ptr Checkpoint -> IO Checkpoint)
-> [Ptr Checkpoint] -> IO [Checkpoint]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ManagedPtr Checkpoint -> Checkpoint)
-> Ptr Checkpoint -> IO Checkpoint
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Checkpoint -> Checkpoint
NM.Checkpoint.Checkpoint) [Ptr Checkpoint]
result'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    [Checkpoint] -> IO [Checkpoint]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Checkpoint]
result''

#if defined(ENABLE_OVERLOADING)
data ClientGetCheckpointsMethodInfo
instance (signature ~ (m [NM.Checkpoint.Checkpoint]), MonadIO m, IsClient a) => O.OverloadedMethod ClientGetCheckpointsMethodInfo a signature where
    overloadedMethod = clientGetCheckpoints

instance O.OverloadedMethodInfo ClientGetCheckpointsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientGetCheckpoints",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientGetCheckpoints"
        })


#endif

-- method Client::get_connection_by_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the %NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the id of the remote connection"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "NM" , name = "RemoteConnection" })
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_get_connection_by_id" nm_client_get_connection_by_id :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    CString ->                              -- id : TBasicType TUTF8
    IO (Ptr NM.RemoteConnection.RemoteConnection)

-- | Returns the first matching @/NMRemoteConnection/@ matching a given /@id@/.
clientGetConnectionById ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a) =>
    a
    -- ^ /@client@/: the @/NMClient/@
    -> T.Text
    -- ^ /@id@/: the id of the remote connection
    -> m NM.RemoteConnection.RemoteConnection
    -- ^ __Returns:__ the remote connection object on success, or 'P.Nothing' if no
    --  matching object was found.
    -- 
    -- The connection is as received from D-Bus and might not validate according
    -- to 'GI.NM.Interfaces.Connection.connectionVerify'.
clientGetConnectionById :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClient a) =>
a -> Text -> m RemoteConnection
clientGetConnectionById a
client Text
id = IO RemoteConnection -> m RemoteConnection
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RemoteConnection -> m RemoteConnection)
-> IO RemoteConnection -> m RemoteConnection
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr CChar
id' <- Text -> IO (Ptr CChar)
textToCString Text
id
    Ptr RemoteConnection
result <- Ptr Client -> Ptr CChar -> IO (Ptr RemoteConnection)
nm_client_get_connection_by_id Ptr Client
client' Ptr CChar
id'
    Text -> Ptr RemoteConnection -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"clientGetConnectionById" Ptr RemoteConnection
result
    RemoteConnection
result' <- ((ManagedPtr RemoteConnection -> RemoteConnection)
-> Ptr RemoteConnection -> IO RemoteConnection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr RemoteConnection -> RemoteConnection
NM.RemoteConnection.RemoteConnection) Ptr RemoteConnection
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
id'
    RemoteConnection -> IO RemoteConnection
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return RemoteConnection
result'

#if defined(ENABLE_OVERLOADING)
data ClientGetConnectionByIdMethodInfo
instance (signature ~ (T.Text -> m NM.RemoteConnection.RemoteConnection), MonadIO m, IsClient a) => O.OverloadedMethod ClientGetConnectionByIdMethodInfo a signature where
    overloadedMethod = clientGetConnectionById

instance O.OverloadedMethodInfo ClientGetConnectionByIdMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientGetConnectionById",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientGetConnectionById"
        })


#endif

-- method Client::get_connection_by_path
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the %NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the D-Bus object path of the remote connection"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "NM" , name = "RemoteConnection" })
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_get_connection_by_path" nm_client_get_connection_by_path :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    CString ->                              -- path : TBasicType TUTF8
    IO (Ptr NM.RemoteConnection.RemoteConnection)

-- | Returns the @/NMRemoteConnection/@ representing the connection at /@path@/.
clientGetConnectionByPath ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a) =>
    a
    -- ^ /@client@/: the @/NMClient/@
    -> T.Text
    -- ^ /@path@/: the D-Bus object path of the remote connection
    -> m NM.RemoteConnection.RemoteConnection
    -- ^ __Returns:__ the remote connection object on success, or 'P.Nothing' if the object was
    --  not known
    -- 
    -- The connection is as received from D-Bus and might not validate according
    -- to 'GI.NM.Interfaces.Connection.connectionVerify'.
clientGetConnectionByPath :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClient a) =>
a -> Text -> m RemoteConnection
clientGetConnectionByPath a
client Text
path = IO RemoteConnection -> m RemoteConnection
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RemoteConnection -> m RemoteConnection)
-> IO RemoteConnection -> m RemoteConnection
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr CChar
path' <- Text -> IO (Ptr CChar)
textToCString Text
path
    Ptr RemoteConnection
result <- Ptr Client -> Ptr CChar -> IO (Ptr RemoteConnection)
nm_client_get_connection_by_path Ptr Client
client' Ptr CChar
path'
    Text -> Ptr RemoteConnection -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"clientGetConnectionByPath" Ptr RemoteConnection
result
    RemoteConnection
result' <- ((ManagedPtr RemoteConnection -> RemoteConnection)
-> Ptr RemoteConnection -> IO RemoteConnection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr RemoteConnection -> RemoteConnection
NM.RemoteConnection.RemoteConnection) Ptr RemoteConnection
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
path'
    RemoteConnection -> IO RemoteConnection
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return RemoteConnection
result'

#if defined(ENABLE_OVERLOADING)
data ClientGetConnectionByPathMethodInfo
instance (signature ~ (T.Text -> m NM.RemoteConnection.RemoteConnection), MonadIO m, IsClient a) => O.OverloadedMethod ClientGetConnectionByPathMethodInfo a signature where
    overloadedMethod = clientGetConnectionByPath

instance O.OverloadedMethodInfo ClientGetConnectionByPathMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientGetConnectionByPath",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientGetConnectionByPath"
        })


#endif

-- method Client::get_connection_by_uuid
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the %NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "uuid"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the UUID of the remote connection"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "NM" , name = "RemoteConnection" })
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_get_connection_by_uuid" nm_client_get_connection_by_uuid :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    CString ->                              -- uuid : TBasicType TUTF8
    IO (Ptr NM.RemoteConnection.RemoteConnection)

-- | Returns the @/NMRemoteConnection/@ identified by /@uuid@/.
clientGetConnectionByUuid ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a) =>
    a
    -- ^ /@client@/: the @/NMClient/@
    -> T.Text
    -- ^ /@uuid@/: the UUID of the remote connection
    -> m NM.RemoteConnection.RemoteConnection
    -- ^ __Returns:__ the remote connection object on success, or 'P.Nothing' if the object was
    --  not known
    -- 
    -- The connection is as received from D-Bus and might not validate according
    -- to 'GI.NM.Interfaces.Connection.connectionVerify'.
clientGetConnectionByUuid :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClient a) =>
a -> Text -> m RemoteConnection
clientGetConnectionByUuid a
client Text
uuid = IO RemoteConnection -> m RemoteConnection
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RemoteConnection -> m RemoteConnection)
-> IO RemoteConnection -> m RemoteConnection
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr CChar
uuid' <- Text -> IO (Ptr CChar)
textToCString Text
uuid
    Ptr RemoteConnection
result <- Ptr Client -> Ptr CChar -> IO (Ptr RemoteConnection)
nm_client_get_connection_by_uuid Ptr Client
client' Ptr CChar
uuid'
    Text -> Ptr RemoteConnection -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"clientGetConnectionByUuid" Ptr RemoteConnection
result
    RemoteConnection
result' <- ((ManagedPtr RemoteConnection -> RemoteConnection)
-> Ptr RemoteConnection -> IO RemoteConnection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr RemoteConnection -> RemoteConnection
NM.RemoteConnection.RemoteConnection) Ptr RemoteConnection
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
uuid'
    RemoteConnection -> IO RemoteConnection
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return RemoteConnection
result'

#if defined(ENABLE_OVERLOADING)
data ClientGetConnectionByUuidMethodInfo
instance (signature ~ (T.Text -> m NM.RemoteConnection.RemoteConnection), MonadIO m, IsClient a) => O.OverloadedMethod ClientGetConnectionByUuidMethodInfo a signature where
    overloadedMethod = clientGetConnectionByUuid

instance O.OverloadedMethodInfo ClientGetConnectionByUuidMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientGetConnectionByUuid",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientGetConnectionByUuid"
        })


#endif

-- method Client::get_connections
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the %NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TPtrArray
--                  (TInterface Name { namespace = "NM" , name = "RemoteConnection" }))
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_get_connections" nm_client_get_connections :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    IO (Ptr (GPtrArray (Ptr NM.RemoteConnection.RemoteConnection)))

-- | /No description available in the introspection data./
clientGetConnections ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a) =>
    a
    -- ^ /@client@/: the @/NMClient/@
    -> m [NM.RemoteConnection.RemoteConnection]
    -- ^ __Returns:__ an array
    -- containing all connections provided by the remote settings service.  The
    -- returned array is owned by the t'GI.NM.Objects.Client.Client' object and should not be modified.
    -- 
    -- The connections are as received from D-Bus and might not validate according
    -- to 'GI.NM.Interfaces.Connection.connectionVerify'.
clientGetConnections :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClient a) =>
a -> m [RemoteConnection]
clientGetConnections a
client = IO [RemoteConnection] -> m [RemoteConnection]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [RemoteConnection] -> m [RemoteConnection])
-> IO [RemoteConnection] -> m [RemoteConnection]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr (GPtrArray (Ptr RemoteConnection))
result <- Ptr Client -> IO (Ptr (GPtrArray (Ptr RemoteConnection)))
nm_client_get_connections Ptr Client
client'
    Text -> Ptr (GPtrArray (Ptr RemoteConnection)) -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"clientGetConnections" Ptr (GPtrArray (Ptr RemoteConnection))
result
    [Ptr RemoteConnection]
result' <- Ptr (GPtrArray (Ptr RemoteConnection)) -> IO [Ptr RemoteConnection]
forall a. Ptr (GPtrArray (Ptr a)) -> IO [Ptr a]
unpackGPtrArray Ptr (GPtrArray (Ptr RemoteConnection))
result
    [RemoteConnection]
result'' <- (Ptr RemoteConnection -> IO RemoteConnection)
-> [Ptr RemoteConnection] -> IO [RemoteConnection]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ManagedPtr RemoteConnection -> RemoteConnection)
-> Ptr RemoteConnection -> IO RemoteConnection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr RemoteConnection -> RemoteConnection
NM.RemoteConnection.RemoteConnection) [Ptr RemoteConnection]
result'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    [RemoteConnection] -> IO [RemoteConnection]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [RemoteConnection]
result''

#if defined(ENABLE_OVERLOADING)
data ClientGetConnectionsMethodInfo
instance (signature ~ (m [NM.RemoteConnection.RemoteConnection]), MonadIO m, IsClient a) => O.OverloadedMethod ClientGetConnectionsMethodInfo a signature where
    overloadedMethod = clientGetConnections

instance O.OverloadedMethodInfo ClientGetConnectionsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientGetConnections",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientGetConnections"
        })


#endif

-- method Client::get_connectivity
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "NM" , name = "ConnectivityState" })
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_get_connectivity" nm_client_get_connectivity :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    IO CUInt

-- | Gets the current network connectivity state. Contrast
-- 'GI.NM.Objects.Client.clientCheckConnectivity' and
-- 'GI.NM.Objects.Client.clientCheckConnectivityAsync', which re-check the
-- connectivity state first before returning any information.
clientGetConnectivity ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a) =>
    a
    -- ^ /@client@/: an t'GI.NM.Objects.Client.Client'
    -> m NM.Enums.ConnectivityState
    -- ^ __Returns:__ the current connectivity state
clientGetConnectivity :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClient a) =>
a -> m ConnectivityState
clientGetConnectivity a
client = IO ConnectivityState -> m ConnectivityState
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ConnectivityState -> m ConnectivityState)
-> IO ConnectivityState -> m ConnectivityState
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    CUInt
result <- Ptr Client -> IO CUInt
nm_client_get_connectivity Ptr Client
client'
    let result' :: ConnectivityState
result' = (Int -> ConnectivityState
forall a. Enum a => Int -> a
toEnum (Int -> ConnectivityState)
-> (CUInt -> Int) -> CUInt -> ConnectivityState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    ConnectivityState -> IO ConnectivityState
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ConnectivityState
result'

#if defined(ENABLE_OVERLOADING)
data ClientGetConnectivityMethodInfo
instance (signature ~ (m NM.Enums.ConnectivityState), MonadIO m, IsClient a) => O.OverloadedMethod ClientGetConnectivityMethodInfo a signature where
    overloadedMethod = clientGetConnectivity

instance O.OverloadedMethodInfo ClientGetConnectivityMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientGetConnectivity",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientGetConnectivity"
        })


#endif

-- method Client::get_context_busy_watcher
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the NMClient instance."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GObject" , name = "Object" })
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_get_context_busy_watcher" nm_client_get_context_busy_watcher :: 
    Ptr Client ->                           -- self : TInterface (Name {namespace = "NM", name = "Client"})
    IO (Ptr GObject.Object.Object)

-- | /No description available in the introspection data./
-- 
-- /Since: 1.22/
clientGetContextBusyWatcher ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a) =>
    a
    -- ^ /@self@/: the NMClient instance.
    -> m GObject.Object.Object
    -- ^ __Returns:__ a GObject that stays alive as long as there are pending
    --   D-Bus operations.
    -- 
    -- NMClient will schedule asynchronous D-Bus requests which will complete on
    -- the GMainContext associated with the instance. When destroying the NMClient
    -- instance, those requests are cancelled right away, however their pending requests are
    -- still outstanding and queued in the GMainContext. These outstanding callbacks
    -- keep the GMainContext alive. In order to fully release all resources,
    -- the user must keep iterating the main context until all these callbacks
    -- are handled. Of course, at this point no more actual callbacks will be invoked
    -- for the user, those are all cancelled internally.
    -- 
    -- This just leaves one problem: how long does the user need to keep the
    -- GMainContext running to ensure everything is cleaned up? The answer is
    -- this GObject. Subscribe a weak reference to the returned object and keep
    -- iterating the main context until the object got unreferenced.
    -- 
    -- Note that after the NMClient instance gets destroyed, all outstanding operations
    -- will be cancelled right away. That means, the user needs to iterate the t'GI.GLib.Structs.MainContext.MainContext'
    -- a bit longer, but it is guaranteed that the cleanup happens soon after.
    -- 
    -- The way of using the context-busy-watch, is by registering a weak pointer to
    -- see when it gets destroyed. That means, user code should not take additional
    -- references on this object to not keep it alive longer.
    -- 
    -- If you plan to exit the program after releasing the NMClient instance
    -- you may not need to worry about these \"leaks\". Also, if you anyway plan to continue
    -- iterating the t'GI.GLib.Structs.MainContext.MainContext' afterwards, then you don\'t need to care when exactly
    -- NMClient is gone completely.
clientGetContextBusyWatcher :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClient a) =>
a -> m Object
clientGetContextBusyWatcher a
self = IO Object -> m Object
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Object -> m Object) -> IO Object -> m Object
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
self' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Object
result <- Ptr Client -> IO (Ptr Object)
nm_client_get_context_busy_watcher Ptr Client
self'
    Text -> Ptr Object -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"clientGetContextBusyWatcher" Ptr Object
result
    Object
result' <- ((ManagedPtr Object -> Object) -> Ptr Object -> IO Object
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Object -> Object
GObject.Object.Object) Ptr Object
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Object -> IO Object
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Object
result'

#if defined(ENABLE_OVERLOADING)
data ClientGetContextBusyWatcherMethodInfo
instance (signature ~ (m GObject.Object.Object), MonadIO m, IsClient a) => O.OverloadedMethod ClientGetContextBusyWatcherMethodInfo a signature where
    overloadedMethod = clientGetContextBusyWatcher

instance O.OverloadedMethodInfo ClientGetContextBusyWatcherMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientGetContextBusyWatcher",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientGetContextBusyWatcher"
        })


#endif

-- method Client::get_dbus_connection
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gio" , name = "DBusConnection" })
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_get_dbus_connection" nm_client_get_dbus_connection :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    IO (Ptr Gio.DBusConnection.DBusConnection)

-- | Gets the @/GDBusConnection/@ of the instance. This can be either passed when
-- constructing the instance (as \"dbus-connection\" property), or it will be
-- automatically initialized during async\/sync init.
-- 
-- /Since: 1.22/
clientGetDbusConnection ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a) =>
    a
    -- ^ /@client@/: a t'GI.NM.Objects.Client.Client'
    -> m Gio.DBusConnection.DBusConnection
    -- ^ __Returns:__ the D-Bus connection of the client, or 'P.Nothing' if none is set.
clientGetDbusConnection :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClient a) =>
a -> m DBusConnection
clientGetDbusConnection a
client = IO DBusConnection -> m DBusConnection
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DBusConnection -> m DBusConnection)
-> IO DBusConnection -> m DBusConnection
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr DBusConnection
result <- Ptr Client -> IO (Ptr DBusConnection)
nm_client_get_dbus_connection Ptr Client
client'
    Text -> Ptr DBusConnection -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"clientGetDbusConnection" Ptr DBusConnection
result
    DBusConnection
result' <- ((ManagedPtr DBusConnection -> DBusConnection)
-> Ptr DBusConnection -> IO DBusConnection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr DBusConnection -> DBusConnection
Gio.DBusConnection.DBusConnection) Ptr DBusConnection
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    DBusConnection -> IO DBusConnection
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return DBusConnection
result'

#if defined(ENABLE_OVERLOADING)
data ClientGetDbusConnectionMethodInfo
instance (signature ~ (m Gio.DBusConnection.DBusConnection), MonadIO m, IsClient a) => O.OverloadedMethod ClientGetDbusConnectionMethodInfo a signature where
    overloadedMethod = clientGetDbusConnection

instance O.OverloadedMethodInfo ClientGetDbusConnectionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientGetDbusConnection",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientGetDbusConnection"
        })


#endif

-- method Client::get_dbus_name_owner
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_get_dbus_name_owner" nm_client_get_dbus_name_owner :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    IO CString

-- | /No description available in the introspection data./
-- 
-- /Since: 1.22/
clientGetDbusNameOwner ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a) =>
    a
    -- ^ /@client@/: a t'GI.NM.Objects.Client.Client'
    -> m T.Text
    -- ^ __Returns:__ the current name owner of the D-Bus service of NetworkManager.
clientGetDbusNameOwner :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClient a) =>
a -> m Text
clientGetDbusNameOwner a
client = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr CChar
result <- Ptr Client -> IO (Ptr CChar)
nm_client_get_dbus_name_owner Ptr Client
client'
    Text -> Ptr CChar -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"clientGetDbusNameOwner" Ptr CChar
result
    Text
result' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data ClientGetDbusNameOwnerMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsClient a) => O.OverloadedMethod ClientGetDbusNameOwnerMethodInfo a signature where
    overloadedMethod = clientGetDbusNameOwner

instance O.OverloadedMethodInfo ClientGetDbusNameOwnerMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientGetDbusNameOwner",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientGetDbusNameOwner"
        })


#endif

-- method Client::get_device_by_iface
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "iface"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the interface name to search for"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "NM" , name = "Device" })
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_get_device_by_iface" nm_client_get_device_by_iface :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    CString ->                              -- iface : TBasicType TUTF8
    IO (Ptr NM.Device.Device)

-- | Gets a t'GI.NM.Objects.Device.Device' from a t'GI.NM.Objects.Client.Client'.
clientGetDeviceByIface ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a) =>
    a
    -- ^ /@client@/: a t'GI.NM.Objects.Client.Client'
    -> T.Text
    -- ^ /@iface@/: the interface name to search for
    -> m NM.Device.Device
    -- ^ __Returns:__ the t'GI.NM.Objects.Device.Device' for the given /@iface@/ or 'P.Nothing' if none is found.
clientGetDeviceByIface :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClient a) =>
a -> Text -> m Device
clientGetDeviceByIface a
client Text
iface = IO Device -> m Device
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Device -> m Device) -> IO Device -> m Device
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr CChar
iface' <- Text -> IO (Ptr CChar)
textToCString Text
iface
    Ptr Device
result <- Ptr Client -> Ptr CChar -> IO (Ptr Device)
nm_client_get_device_by_iface Ptr Client
client' Ptr CChar
iface'
    Text -> Ptr Device -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"clientGetDeviceByIface" Ptr Device
result
    Device
result' <- ((ManagedPtr Device -> Device) -> Ptr Device -> IO Device
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Device -> Device
NM.Device.Device) Ptr Device
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
iface'
    Device -> IO Device
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Device
result'

#if defined(ENABLE_OVERLOADING)
data ClientGetDeviceByIfaceMethodInfo
instance (signature ~ (T.Text -> m NM.Device.Device), MonadIO m, IsClient a) => O.OverloadedMethod ClientGetDeviceByIfaceMethodInfo a signature where
    overloadedMethod = clientGetDeviceByIface

instance O.OverloadedMethodInfo ClientGetDeviceByIfaceMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientGetDeviceByIface",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientGetDeviceByIface"
        })


#endif

-- method Client::get_device_by_path
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "object_path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the object path to search for"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "NM" , name = "Device" })
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_get_device_by_path" nm_client_get_device_by_path :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    CString ->                              -- object_path : TBasicType TUTF8
    IO (Ptr NM.Device.Device)

-- | Gets a t'GI.NM.Objects.Device.Device' from a t'GI.NM.Objects.Client.Client'.
clientGetDeviceByPath ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a) =>
    a
    -- ^ /@client@/: a t'GI.NM.Objects.Client.Client'
    -> T.Text
    -- ^ /@objectPath@/: the object path to search for
    -> m NM.Device.Device
    -- ^ __Returns:__ the t'GI.NM.Objects.Device.Device' for the given /@objectPath@/ or 'P.Nothing' if none is found.
clientGetDeviceByPath :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClient a) =>
a -> Text -> m Device
clientGetDeviceByPath a
client Text
objectPath = IO Device -> m Device
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Device -> m Device) -> IO Device -> m Device
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr CChar
objectPath' <- Text -> IO (Ptr CChar)
textToCString Text
objectPath
    Ptr Device
result <- Ptr Client -> Ptr CChar -> IO (Ptr Device)
nm_client_get_device_by_path Ptr Client
client' Ptr CChar
objectPath'
    Text -> Ptr Device -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"clientGetDeviceByPath" Ptr Device
result
    Device
result' <- ((ManagedPtr Device -> Device) -> Ptr Device -> IO Device
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Device -> Device
NM.Device.Device) Ptr Device
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
objectPath'
    Device -> IO Device
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Device
result'

#if defined(ENABLE_OVERLOADING)
data ClientGetDeviceByPathMethodInfo
instance (signature ~ (T.Text -> m NM.Device.Device), MonadIO m, IsClient a) => O.OverloadedMethod ClientGetDeviceByPathMethodInfo a signature where
    overloadedMethod = clientGetDeviceByPath

instance O.OverloadedMethodInfo ClientGetDeviceByPathMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientGetDeviceByPath",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientGetDeviceByPath"
        })


#endif

-- method Client::get_devices
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TPtrArray
--                  (TInterface Name { namespace = "NM" , name = "Device" }))
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_get_devices" nm_client_get_devices :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    IO (Ptr (GPtrArray (Ptr NM.Device.Device)))

-- | Gets all the known network devices.  Use @/nm_device_get_type()/@ or the
-- \<literal>NM_IS_DEVICE_XXXX\<\/literal> functions to determine what kind of
-- device member of the returned array is, and then you may use device-specific
-- methods such as @/nm_device_ethernet_get_hw_address()/@.
clientGetDevices ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a) =>
    a
    -- ^ /@client@/: a t'GI.NM.Objects.Client.Client'
    -> m [NM.Device.Device]
    -- ^ __Returns:__ a t'GI.GLib.Structs.PtrArray.PtrArray'
    -- containing all the @/NMDevices/@.  The returned array is owned by the
    -- t'GI.NM.Objects.Client.Client' object and should not be modified.
clientGetDevices :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClient a) =>
a -> m [Device]
clientGetDevices a
client = IO [Device] -> m [Device]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Device] -> m [Device]) -> IO [Device] -> m [Device]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr (GPtrArray (Ptr Device))
result <- Ptr Client -> IO (Ptr (GPtrArray (Ptr Device)))
nm_client_get_devices Ptr Client
client'
    Text -> Ptr (GPtrArray (Ptr Device)) -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"clientGetDevices" Ptr (GPtrArray (Ptr Device))
result
    [Ptr Device]
result' <- Ptr (GPtrArray (Ptr Device)) -> IO [Ptr Device]
forall a. Ptr (GPtrArray (Ptr a)) -> IO [Ptr a]
unpackGPtrArray Ptr (GPtrArray (Ptr Device))
result
    [Device]
result'' <- (Ptr Device -> IO Device) -> [Ptr Device] -> IO [Device]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ManagedPtr Device -> Device) -> Ptr Device -> IO Device
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Device -> Device
NM.Device.Device) [Ptr Device]
result'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    [Device] -> IO [Device]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Device]
result''

#if defined(ENABLE_OVERLOADING)
data ClientGetDevicesMethodInfo
instance (signature ~ (m [NM.Device.Device]), MonadIO m, IsClient a) => O.OverloadedMethod ClientGetDevicesMethodInfo a signature where
    overloadedMethod = clientGetDevices

instance O.OverloadedMethodInfo ClientGetDevicesMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientGetDevices",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientGetDevices"
        })


#endif

-- method Client::get_dns_configuration
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TPtrArray
--                  (TInterface Name { namespace = "NM" , name = "DnsEntry" }))
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_get_dns_configuration" nm_client_get_dns_configuration :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    IO (Ptr (GPtrArray (Ptr NM.DnsEntry.DnsEntry)))

-- | Gets the current DNS configuration
-- 
-- /Since: 1.6/
clientGetDnsConfiguration ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a) =>
    a
    -- ^ /@client@/: a t'GI.NM.Objects.Client.Client'
    -> m [NM.DnsEntry.DnsEntry]
    -- ^ __Returns:__ a t'GI.GLib.Structs.PtrArray.PtrArray'
    -- containing t'GI.NM.Structs.DnsEntry.DnsEntry' elements or 'P.Nothing' in case the value is not
    -- available.  The returned array is owned by the t'GI.NM.Objects.Client.Client' object
    -- and should not be modified.
clientGetDnsConfiguration :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClient a) =>
a -> m [DnsEntry]
clientGetDnsConfiguration a
client = IO [DnsEntry] -> m [DnsEntry]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [DnsEntry] -> m [DnsEntry]) -> IO [DnsEntry] -> m [DnsEntry]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr (GPtrArray (Ptr DnsEntry))
result <- Ptr Client -> IO (Ptr (GPtrArray (Ptr DnsEntry)))
nm_client_get_dns_configuration Ptr Client
client'
    Text -> Ptr (GPtrArray (Ptr DnsEntry)) -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"clientGetDnsConfiguration" Ptr (GPtrArray (Ptr DnsEntry))
result
    [Ptr DnsEntry]
result' <- Ptr (GPtrArray (Ptr DnsEntry)) -> IO [Ptr DnsEntry]
forall a. Ptr (GPtrArray (Ptr a)) -> IO [Ptr a]
unpackGPtrArray Ptr (GPtrArray (Ptr DnsEntry))
result
    [DnsEntry]
result'' <- (Ptr DnsEntry -> IO DnsEntry) -> [Ptr DnsEntry] -> IO [DnsEntry]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ManagedPtr DnsEntry -> DnsEntry) -> Ptr DnsEntry -> IO DnsEntry
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr DnsEntry -> DnsEntry
NM.DnsEntry.DnsEntry) [Ptr DnsEntry]
result'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    [DnsEntry] -> IO [DnsEntry]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [DnsEntry]
result''

#if defined(ENABLE_OVERLOADING)
data ClientGetDnsConfigurationMethodInfo
instance (signature ~ (m [NM.DnsEntry.DnsEntry]), MonadIO m, IsClient a) => O.OverloadedMethod ClientGetDnsConfigurationMethodInfo a signature where
    overloadedMethod = clientGetDnsConfiguration

instance O.OverloadedMethodInfo ClientGetDnsConfigurationMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientGetDnsConfiguration",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientGetDnsConfiguration"
        })


#endif

-- method Client::get_dns_mode
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_get_dns_mode" nm_client_get_dns_mode :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    IO CString

-- | Gets the current DNS processing mode.
-- 
-- /Since: 1.6/
clientGetDnsMode ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a) =>
    a
    -- ^ /@client@/: the t'GI.NM.Objects.Client.Client'
    -> m T.Text
    -- ^ __Returns:__ the DNS processing mode, or 'P.Nothing' in case the
    --   value is not available.
clientGetDnsMode :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClient a) =>
a -> m Text
clientGetDnsMode a
client = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr CChar
result <- Ptr Client -> IO (Ptr CChar)
nm_client_get_dns_mode Ptr Client
client'
    Text -> Ptr CChar -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"clientGetDnsMode" Ptr CChar
result
    Text
result' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data ClientGetDnsModeMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsClient a) => O.OverloadedMethod ClientGetDnsModeMethodInfo a signature where
    overloadedMethod = clientGetDnsMode

instance O.OverloadedMethodInfo ClientGetDnsModeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientGetDnsMode",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientGetDnsMode"
        })


#endif

-- method Client::get_dns_rc_manager
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_get_dns_rc_manager" nm_client_get_dns_rc_manager :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    IO CString

-- | Gets the current DNS resolv.conf manager.
-- 
-- /Since: 1.6/
clientGetDnsRcManager ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a) =>
    a
    -- ^ /@client@/: the t'GI.NM.Objects.Client.Client'
    -> m T.Text
    -- ^ __Returns:__ the resolv.conf manager or 'P.Nothing' in case the
    --   value is not available.
clientGetDnsRcManager :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClient a) =>
a -> m Text
clientGetDnsRcManager a
client = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr CChar
result <- Ptr Client -> IO (Ptr CChar)
nm_client_get_dns_rc_manager Ptr Client
client'
    Text -> Ptr CChar -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"clientGetDnsRcManager" Ptr CChar
result
    Text
result' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data ClientGetDnsRcManagerMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsClient a) => O.OverloadedMethod ClientGetDnsRcManagerMethodInfo a signature where
    overloadedMethod = clientGetDnsRcManager

instance O.OverloadedMethodInfo ClientGetDnsRcManagerMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientGetDnsRcManager",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientGetDnsRcManager"
        })


#endif

-- method Client::get_instance_flags
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMClient instance."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "NM" , name = "ClientInstanceFlags" })
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_get_instance_flags" nm_client_get_instance_flags :: 
    Ptr Client ->                           -- self : TInterface (Name {namespace = "NM", name = "Client"})
    IO CUInt

-- | /No description available in the introspection data./
-- 
-- /Since: 1.24/
clientGetInstanceFlags ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a) =>
    a
    -- ^ /@self@/: the t'GI.NM.Objects.Client.Client' instance.
    -> m [NM.Flags.ClientInstanceFlags]
    -- ^ __Returns:__ the t'GI.NM.Flags.ClientInstanceFlags' flags.
clientGetInstanceFlags :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClient a) =>
a -> m [ClientInstanceFlags]
clientGetInstanceFlags a
self = IO [ClientInstanceFlags] -> m [ClientInstanceFlags]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ClientInstanceFlags] -> m [ClientInstanceFlags])
-> IO [ClientInstanceFlags] -> m [ClientInstanceFlags]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
self' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CUInt
result <- Ptr Client -> IO CUInt
nm_client_get_instance_flags Ptr Client
self'
    let result' :: [ClientInstanceFlags]
result' = CUInt -> [ClientInstanceFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    [ClientInstanceFlags] -> IO [ClientInstanceFlags]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [ClientInstanceFlags]
result'

#if defined(ENABLE_OVERLOADING)
data ClientGetInstanceFlagsMethodInfo
instance (signature ~ (m [NM.Flags.ClientInstanceFlags]), MonadIO m, IsClient a) => O.OverloadedMethod ClientGetInstanceFlagsMethodInfo a signature where
    overloadedMethod = clientGetInstanceFlags

instance O.OverloadedMethodInfo ClientGetInstanceFlagsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientGetInstanceFlags",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientGetInstanceFlags"
        })


#endif

-- method Client::get_logging
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "level"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for logging level string"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "domains"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "return location for log domains string. The string is\n  a list of domains separated by \",\""
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "nm_client_get_logging" nm_client_get_logging :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    Ptr CString ->                          -- level : TBasicType TUTF8
    Ptr CString ->                          -- domains : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO CInt

{-# DEPRECATED clientGetLogging ["(Since version 1.22)","Use the async command 'GI.NM.Objects.Client.clientDbusCall' on 'GI.NM.Constants.DBUS_PATH',","'GI.NM.Constants.DBUS_INTERFACE' to call \\\"GetLogging\\\" with no arguments to get \\\"(ss)\\\" for level","and domains."] #-}
-- | Gets NetworkManager current logging level and domains.
clientGetLogging ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a) =>
    a
    -- ^ /@client@/: a t'GI.NM.Objects.Client.Client'
    -> m ((Maybe T.Text, Maybe T.Text))
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
clientGetLogging :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClient a) =>
a -> m (Maybe Text, Maybe Text)
clientGetLogging a
client = IO (Maybe Text, Maybe Text) -> m (Maybe Text, Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text, Maybe Text) -> m (Maybe Text, Maybe Text))
-> IO (Maybe Text, Maybe Text) -> m (Maybe Text, Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr (Ptr CChar)
level <- IO (Ptr (Ptr CChar))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr CString)
    Ptr (Ptr CChar)
domains <- IO (Ptr (Ptr CChar))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr CString)
    IO (Maybe Text, Maybe Text) -> IO () -> IO (Maybe Text, Maybe Text)
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Client
-> Ptr (Ptr CChar)
-> Ptr (Ptr CChar)
-> Ptr (Ptr GError)
-> IO CInt
nm_client_get_logging Ptr Client
client' Ptr (Ptr CChar)
level Ptr (Ptr CChar)
domains
        Ptr CChar
level' <- Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
level
        Maybe Text
maybeLevel' <- Ptr CChar -> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CChar
level' ((Ptr CChar -> IO Text) -> IO (Maybe Text))
-> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
level'' -> do
            Text
level''' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
level''
            Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
level'''
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
level'
        Ptr CChar
domains' <- Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
domains
        Maybe Text
maybeDomains' <- Ptr CChar -> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CChar
domains' ((Ptr CChar -> IO Text) -> IO (Maybe Text))
-> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
domains'' -> do
            Text
domains''' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
domains''
            Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
domains'''
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
domains'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
        Ptr (Ptr CChar) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr CChar)
level
        Ptr (Ptr CChar) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr CChar)
domains
        (Maybe Text, Maybe Text) -> IO (Maybe Text, Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text
maybeLevel', Maybe Text
maybeDomains')
     ) (do
        Ptr (Ptr CChar) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr CChar)
level
        Ptr (Ptr CChar) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr CChar)
domains
     )

#if defined(ENABLE_OVERLOADING)
data ClientGetLoggingMethodInfo
instance (signature ~ (m ((Maybe T.Text, Maybe T.Text))), MonadIO m, IsClient a) => O.OverloadedMethod ClientGetLoggingMethodInfo a signature where
    overloadedMethod = clientGetLogging

instance O.OverloadedMethodInfo ClientGetLoggingMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientGetLogging",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientGetLogging"
        })


#endif

-- method Client::get_main_context
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMClient instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "GLib" , name = "MainContext" })
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_get_main_context" nm_client_get_main_context :: 
    Ptr Client ->                           -- self : TInterface (Name {namespace = "NM", name = "Client"})
    IO (Ptr GLib.MainContext.MainContext)

-- | The t'GI.NM.Objects.Client.Client' instance is permanently associated with the current
-- thread default t'GI.GLib.Structs.MainContext.MainContext', referenced the time when the instance
-- was created. To receive events, the user must iterate this context
-- and can use it to synchronize access to the client.
-- 
-- Note that even after t'GI.NM.Objects.Client.Client' instance got destroyed, there might
-- still be pending sources registered in the context. That means, to fully
-- clean up, the user must continue iterating the context as long as
-- the 'GI.NM.Objects.Client.clientGetContextBusyWatcher' object is alive.
-- 
-- /Since: 1.22/
clientGetMainContext ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a) =>
    a
    -- ^ /@self@/: the t'GI.NM.Objects.Client.Client' instance
    -> m GLib.MainContext.MainContext
    -- ^ __Returns:__ the t'GI.GLib.Structs.MainContext.MainContext' of the client.
clientGetMainContext :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClient a) =>
a -> m MainContext
clientGetMainContext a
self = IO MainContext -> m MainContext
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MainContext -> m MainContext)
-> IO MainContext -> m MainContext
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
self' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr MainContext
result <- Ptr Client -> IO (Ptr MainContext)
nm_client_get_main_context Ptr Client
self'
    Text -> Ptr MainContext -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"clientGetMainContext" Ptr MainContext
result
    MainContext
result' <- ((ManagedPtr MainContext -> MainContext)
-> Ptr MainContext -> IO MainContext
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr MainContext -> MainContext
GLib.MainContext.MainContext) Ptr MainContext
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    MainContext -> IO MainContext
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MainContext
result'

#if defined(ENABLE_OVERLOADING)
data ClientGetMainContextMethodInfo
instance (signature ~ (m GLib.MainContext.MainContext), MonadIO m, IsClient a) => O.OverloadedMethod ClientGetMainContextMethodInfo a signature where
    overloadedMethod = clientGetMainContext

instance O.OverloadedMethodInfo ClientGetMainContextMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientGetMainContext",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientGetMainContext"
        })


#endif

-- method Client::get_metered
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "NM" , name = "Metered" })
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_get_metered" nm_client_get_metered :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    IO CUInt

-- | /No description available in the introspection data./
-- 
-- /Since: 1.22/
clientGetMetered ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a) =>
    a
    -- ^ /@client@/: a t'GI.NM.Objects.Client.Client'
    -> m NM.Enums.Metered
    -- ^ __Returns:__ whether the default route is metered.
clientGetMetered :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClient a) =>
a -> m Metered
clientGetMetered a
client = IO Metered -> m Metered
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Metered -> m Metered) -> IO Metered -> m Metered
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    CUInt
result <- Ptr Client -> IO CUInt
nm_client_get_metered Ptr Client
client'
    let result' :: Metered
result' = (Int -> Metered
forall a. Enum a => Int -> a
toEnum (Int -> Metered) -> (CUInt -> Int) -> CUInt -> Metered
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    Metered -> IO Metered
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Metered
result'

#if defined(ENABLE_OVERLOADING)
data ClientGetMeteredMethodInfo
instance (signature ~ (m NM.Enums.Metered), MonadIO m, IsClient a) => O.OverloadedMethod ClientGetMeteredMethodInfo a signature where
    overloadedMethod = clientGetMetered

instance O.OverloadedMethodInfo ClientGetMeteredMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientGetMetered",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientGetMetered"
        })


#endif

-- method Client::get_nm_running
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_get_nm_running" nm_client_get_nm_running :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    IO CInt

-- | Determines whether the daemon is running.
clientGetNmRunning ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a) =>
    a
    -- ^ /@client@/: a t'GI.NM.Objects.Client.Client'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the daemon is running
clientGetNmRunning :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClient a) =>
a -> m Bool
clientGetNmRunning a
client = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    CInt
result <- Ptr Client -> IO CInt
nm_client_get_nm_running Ptr Client
client'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ClientGetNmRunningMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsClient a) => O.OverloadedMethod ClientGetNmRunningMethodInfo a signature where
    overloadedMethod = clientGetNmRunning

instance O.OverloadedMethodInfo ClientGetNmRunningMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientGetNmRunning",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientGetNmRunning"
        })


#endif

-- method Client::get_object_by_path
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMClient instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dbus_path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the D-Bus path of the object to look up"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "NM" , name = "Object" })
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_get_object_by_path" nm_client_get_object_by_path :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    CString ->                              -- dbus_path : TBasicType TUTF8
    IO (Ptr NM.Object.Object)

-- | /No description available in the introspection data./
-- 
-- /Since: 1.24/
clientGetObjectByPath ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a) =>
    a
    -- ^ /@client@/: the t'GI.NM.Objects.Client.Client' instance
    -> T.Text
    -- ^ /@dbusPath@/: the D-Bus path of the object to look up
    -> m NM.Object.Object
    -- ^ __Returns:__ the t'GI.NM.Objects.Object.Object' instance that is
    --   cached under /@dbusPath@/, or 'P.Nothing' if no such object exists.
clientGetObjectByPath :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClient a) =>
a -> Text -> m Object
clientGetObjectByPath a
client Text
dbusPath = IO Object -> m Object
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Object -> m Object) -> IO Object -> m Object
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr CChar
dbusPath' <- Text -> IO (Ptr CChar)
textToCString Text
dbusPath
    Ptr Object
result <- Ptr Client -> Ptr CChar -> IO (Ptr Object)
nm_client_get_object_by_path Ptr Client
client' Ptr CChar
dbusPath'
    Text -> Ptr Object -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"clientGetObjectByPath" Ptr Object
result
    Object
result' <- ((ManagedPtr Object -> Object) -> Ptr Object -> IO Object
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Object -> Object
NM.Object.Object) Ptr Object
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
dbusPath'
    Object -> IO Object
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Object
result'

#if defined(ENABLE_OVERLOADING)
data ClientGetObjectByPathMethodInfo
instance (signature ~ (T.Text -> m NM.Object.Object), MonadIO m, IsClient a) => O.OverloadedMethod ClientGetObjectByPathMethodInfo a signature where
    overloadedMethod = clientGetObjectByPath

instance O.OverloadedMethodInfo ClientGetObjectByPathMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientGetObjectByPath",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientGetObjectByPath"
        })


#endif

-- method Client::get_permission_result
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "permission"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "ClientPermission" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the permission for which to return the result, one of #NMClientPermission"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "NM" , name = "ClientPermissionResult" })
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_get_permission_result" nm_client_get_permission_result :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    CUInt ->                                -- permission : TInterface (Name {namespace = "NM", name = "ClientPermission"})
    IO CUInt

-- | Requests the result of a specific permission, which indicates whether the
-- client can or cannot perform the action the permission represents
clientGetPermissionResult ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a) =>
    a
    -- ^ /@client@/: a t'GI.NM.Objects.Client.Client'
    -> NM.Enums.ClientPermission
    -- ^ /@permission@/: the permission for which to return the result, one of t'GI.NM.Enums.ClientPermission'
    -> m NM.Enums.ClientPermissionResult
    -- ^ __Returns:__ the permission\'s result, one of t'GI.NM.Enums.ClientPermissionResult'
clientGetPermissionResult :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClient a) =>
a -> ClientPermission -> m ClientPermissionResult
clientGetPermissionResult a
client ClientPermission
permission = IO ClientPermissionResult -> m ClientPermissionResult
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ClientPermissionResult -> m ClientPermissionResult)
-> IO ClientPermissionResult -> m ClientPermissionResult
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    let permission' :: CUInt
permission' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (ClientPermission -> Int) -> ClientPermission -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientPermission -> Int
forall a. Enum a => a -> Int
fromEnum) ClientPermission
permission
    CUInt
result <- Ptr Client -> CUInt -> IO CUInt
nm_client_get_permission_result Ptr Client
client' CUInt
permission'
    let result' :: ClientPermissionResult
result' = (Int -> ClientPermissionResult
forall a. Enum a => Int -> a
toEnum (Int -> ClientPermissionResult)
-> (CUInt -> Int) -> CUInt -> ClientPermissionResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    ClientPermissionResult -> IO ClientPermissionResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ClientPermissionResult
result'

#if defined(ENABLE_OVERLOADING)
data ClientGetPermissionResultMethodInfo
instance (signature ~ (NM.Enums.ClientPermission -> m NM.Enums.ClientPermissionResult), MonadIO m, IsClient a) => O.OverloadedMethod ClientGetPermissionResultMethodInfo a signature where
    overloadedMethod = clientGetPermissionResult

instance O.OverloadedMethodInfo ClientGetPermissionResultMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientGetPermissionResult",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientGetPermissionResult"
        })


#endif

-- method Client::get_permissions_state
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMClient instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "NM" , name = "Ternary" })
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_get_permissions_state" nm_client_get_permissions_state :: 
    Ptr Client ->                           -- self : TInterface (Name {namespace = "NM", name = "Client"})
    IO CInt

-- | /No description available in the introspection data./
-- 
-- /Since: 1.24/
clientGetPermissionsState ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a) =>
    a
    -- ^ /@self@/: the t'GI.NM.Objects.Client.Client' instance
    -> m NM.Enums.Ternary
    -- ^ __Returns:__ the state of the cached permissions. 'GI.NM.Enums.TernaryDefault'
    --   means that no permissions result was yet received. All permissions
    --   are unknown. 'GI.NM.Enums.TernaryTrue' means that the permissions got received
    --   and are cached. %'GI.NM.Enums.TernaryFalse' means that permissions are cached,
    --   but they are invalided as \"CheckPermissions\" signal was received
    --   in the meantime.
clientGetPermissionsState :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClient a) =>
a -> m Ternary
clientGetPermissionsState a
self = IO Ternary -> m Ternary
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Ternary -> m Ternary) -> IO Ternary -> m Ternary
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
self' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr Client -> IO CInt
nm_client_get_permissions_state Ptr Client
self'
    let result' :: Ternary
result' = (Int -> Ternary
forall a. Enum a => Int -> a
toEnum (Int -> Ternary) -> (CInt -> Int) -> CInt -> Ternary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Ternary -> IO Ternary
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ternary
result'

#if defined(ENABLE_OVERLOADING)
data ClientGetPermissionsStateMethodInfo
instance (signature ~ (m NM.Enums.Ternary), MonadIO m, IsClient a) => O.OverloadedMethod ClientGetPermissionsStateMethodInfo a signature where
    overloadedMethod = clientGetPermissionsState

instance O.OverloadedMethodInfo ClientGetPermissionsStateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientGetPermissionsState",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientGetPermissionsState"
        })


#endif

-- method Client::get_primary_connection
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "NM" , name = "ActiveConnection" })
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_get_primary_connection" nm_client_get_primary_connection :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    IO (Ptr NM.ActiveConnection.ActiveConnection)

-- | Gets the t'GI.NM.Objects.ActiveConnection.ActiveConnection' corresponding to the primary active
-- network device.
-- 
-- In particular, when there is no VPN active, or the VPN does not
-- have the default route, this returns the active connection that has
-- the default route. If there is a VPN active with the default route,
-- then this function returns the active connection that contains the
-- route to the VPN endpoint.
-- 
-- If there is no default route, or the default route is over a
-- non-NetworkManager-recognized device, this will return 'P.Nothing'.
clientGetPrimaryConnection ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a) =>
    a
    -- ^ /@client@/: an t'GI.NM.Objects.Client.Client'
    -> m NM.ActiveConnection.ActiveConnection
    -- ^ __Returns:__ the appropriate t'GI.NM.Objects.ActiveConnection.ActiveConnection', if
    -- any
clientGetPrimaryConnection :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClient a) =>
a -> m ActiveConnection
clientGetPrimaryConnection a
client = IO ActiveConnection -> m ActiveConnection
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ActiveConnection -> m ActiveConnection)
-> IO ActiveConnection -> m ActiveConnection
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr ActiveConnection
result <- Ptr Client -> IO (Ptr ActiveConnection)
nm_client_get_primary_connection Ptr Client
client'
    Text -> Ptr ActiveConnection -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"clientGetPrimaryConnection" Ptr ActiveConnection
result
    ActiveConnection
result' <- ((ManagedPtr ActiveConnection -> ActiveConnection)
-> Ptr ActiveConnection -> IO ActiveConnection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ActiveConnection -> ActiveConnection
NM.ActiveConnection.ActiveConnection) Ptr ActiveConnection
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    ActiveConnection -> IO ActiveConnection
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ActiveConnection
result'

#if defined(ENABLE_OVERLOADING)
data ClientGetPrimaryConnectionMethodInfo
instance (signature ~ (m NM.ActiveConnection.ActiveConnection), MonadIO m, IsClient a) => O.OverloadedMethod ClientGetPrimaryConnectionMethodInfo a signature where
    overloadedMethod = clientGetPrimaryConnection

instance O.OverloadedMethodInfo ClientGetPrimaryConnectionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientGetPrimaryConnection",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientGetPrimaryConnection"
        })


#endif

-- method Client::get_radio_flags
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "NM" , name = "RadioFlags" })
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_get_radio_flags" nm_client_get_radio_flags :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    IO CUInt

-- | Get radio flags.
-- 
-- /Since: 1.38/
clientGetRadioFlags ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a) =>
    a
    -- ^ /@client@/: a t'GI.NM.Objects.Client.Client'
    -> m [NM.Flags.RadioFlags]
    -- ^ __Returns:__ the t'GI.NM.Flags.RadioFlags'.
clientGetRadioFlags :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClient a) =>
a -> m [RadioFlags]
clientGetRadioFlags a
client = IO [RadioFlags] -> m [RadioFlags]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [RadioFlags] -> m [RadioFlags])
-> IO [RadioFlags] -> m [RadioFlags]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    CUInt
result <- Ptr Client -> IO CUInt
nm_client_get_radio_flags Ptr Client
client'
    let result' :: [RadioFlags]
result' = CUInt -> [RadioFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    [RadioFlags] -> IO [RadioFlags]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [RadioFlags]
result'

#if defined(ENABLE_OVERLOADING)
data ClientGetRadioFlagsMethodInfo
instance (signature ~ (m [NM.Flags.RadioFlags]), MonadIO m, IsClient a) => O.OverloadedMethod ClientGetRadioFlagsMethodInfo a signature where
    overloadedMethod = clientGetRadioFlags

instance O.OverloadedMethodInfo ClientGetRadioFlagsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientGetRadioFlags",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientGetRadioFlags"
        })


#endif

-- method Client::get_startup
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_get_startup" nm_client_get_startup :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    IO CInt

-- | Tests whether the daemon is still in the process of activating
-- connections at startup.
clientGetStartup ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a) =>
    a
    -- ^ /@client@/: a t'GI.NM.Objects.Client.Client'
    -> m Bool
    -- ^ __Returns:__ whether the daemon is still starting up
clientGetStartup :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClient a) =>
a -> m Bool
clientGetStartup a
client = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    CInt
result <- Ptr Client -> IO CInt
nm_client_get_startup Ptr Client
client'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ClientGetStartupMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsClient a) => O.OverloadedMethod ClientGetStartupMethodInfo a signature where
    overloadedMethod = clientGetStartup

instance O.OverloadedMethodInfo ClientGetStartupMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientGetStartup",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientGetStartup"
        })


#endif

-- method Client::get_state
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "NM" , name = "State" })
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_get_state" nm_client_get_state :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    IO CUInt

-- | Gets the current daemon state.
clientGetState ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a) =>
    a
    -- ^ /@client@/: a t'GI.NM.Objects.Client.Client'
    -> m NM.Enums.State
    -- ^ __Returns:__ the current @/NMState/@
clientGetState :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClient a) =>
a -> m State
clientGetState a
client = IO State -> m State
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO State -> m State) -> IO State -> m State
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    CUInt
result <- Ptr Client -> IO CUInt
nm_client_get_state Ptr Client
client'
    let result' :: State
result' = (Int -> State
forall a. Enum a => Int -> a
toEnum (Int -> State) -> (CUInt -> Int) -> CUInt -> State
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    State -> IO State
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return State
result'

#if defined(ENABLE_OVERLOADING)
data ClientGetStateMethodInfo
instance (signature ~ (m NM.Enums.State), MonadIO m, IsClient a) => O.OverloadedMethod ClientGetStateMethodInfo a signature where
    overloadedMethod = clientGetState

instance O.OverloadedMethodInfo ClientGetStateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientGetState",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientGetState"
        })


#endif

-- method Client::get_version
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_get_version" nm_client_get_version :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    IO CString

-- | Gets NetworkManager version.
clientGetVersion ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a) =>
    a
    -- ^ /@client@/: a t'GI.NM.Objects.Client.Client'
    -> m T.Text
    -- ^ __Returns:__ string with the version (or 'P.Nothing' if NetworkManager is not running)
clientGetVersion :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClient a) =>
a -> m Text
clientGetVersion a
client = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr CChar
result <- Ptr Client -> IO (Ptr CChar)
nm_client_get_version Ptr Client
client'
    Text -> Ptr CChar -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"clientGetVersion" Ptr CChar
result
    Text
result' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data ClientGetVersionMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsClient a) => O.OverloadedMethod ClientGetVersionMethodInfo a signature where
    overloadedMethod = clientGetVersion

instance O.OverloadedMethodInfo ClientGetVersionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientGetVersion",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientGetVersion"
        })


#endif

-- method Client::get_version_info
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMClient instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TSize
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of returned capabilities."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "length"
--              , argType = TBasicType TSize
--              , direction = DirectionOut
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the number of returned capabilities."
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , argCallbackUserData = False
--              , transfer = TransferEverything
--              }
--          ]
-- returnType: Just (TCArray False (-1) 1 (TBasicType TUInt32))
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_get_version_info" nm_client_get_version_info :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    Ptr FCT.CSize ->                        -- length : TBasicType TSize
    IO (Ptr Word32)

-- | If available, the first element in the array is NM_VERSION which
-- encodes the daemon version as \"(major \<\< 16 | minor \<\< 8 | micro)\".
-- The following elements are a bitfield of @/NMVersionInfoCapabilities/@
-- that indicate that the daemon supports a certain capability.
-- 
-- /Since: 1.42/
clientGetVersionInfo ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a) =>
    a
    -- ^ /@client@/: the t'GI.NM.Objects.Client.Client' instance
    -> m [Word32]
    -- ^ __Returns:__ the
    --   list of capabilities reported by the server or 'P.Nothing'
    --   if the capabilities are unknown.
clientGetVersionInfo :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClient a) =>
a -> m [Word32]
clientGetVersionInfo a
client = IO [Word32] -> m [Word32]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Word32] -> m [Word32]) -> IO [Word32] -> m [Word32]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr CSize
length_ <- IO (Ptr CSize)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr FCT.CSize)
    Ptr Word32
result <- Ptr Client -> Ptr CSize -> IO (Ptr Word32)
nm_client_get_version_info Ptr Client
client' Ptr CSize
length_
    CSize
length_' <- Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
length_
    Text -> Ptr Word32 -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"clientGetVersionInfo" Ptr Word32
result
    [Word32]
result' <- (CSize -> Ptr Word32 -> IO [Word32]
forall a b. (Integral a, Storable b) => a -> Ptr b -> IO [b]
unpackStorableArrayWithLength CSize
length_') Ptr Word32
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    Ptr CSize -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CSize
length_
    [Word32] -> IO [Word32]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Word32]
result'

#if defined(ENABLE_OVERLOADING)
data ClientGetVersionInfoMethodInfo
instance (signature ~ (m [Word32]), MonadIO m, IsClient a) => O.OverloadedMethod ClientGetVersionInfoMethodInfo a signature where
    overloadedMethod = clientGetVersionInfo

instance O.OverloadedMethodInfo ClientGetVersionInfoMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientGetVersionInfo",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientGetVersionInfo"
        })


#endif

-- method Client::load_connections
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the %NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "filenames"
--           , argType = TCArray True (-1) (-1) (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%NULL-terminated array of filenames to load"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "failures"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "on return, a %NULL-terminated array of\n  filenames that failed to load"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "nm_client_load_connections" nm_client_load_connections :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    Ptr CString ->                          -- filenames : TCArray True (-1) (-1) (TBasicType TUTF8)
    Ptr CString ->                          -- failures : TBasicType TUTF8
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

{-# DEPRECATED clientLoadConnections ["(Since version 1.22)","Use 'GI.NM.Objects.Client.clientLoadConnectionsAsync' or GDBusConnection."] #-}
-- | Requests that the remote settings service load or reload the given files,
-- adding or updating the connections described within.
-- 
-- The changes to the indicated files will not yet be reflected in
-- /@client@/\'s connections array when the function returns.
-- 
-- If all of the indicated files were successfully loaded, the
-- function will return 'P.True', and /@failures@/ will be set to 'P.Nothing'. If
-- NetworkManager tried to load the files, but some (or all) failed,
-- then /@failures@/ will be set to a 'P.Nothing'-terminated array of the
-- filenames that failed to load.
clientLoadConnections ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@client@/: the @/NMClient/@
    -> [T.Text]
    -- ^ /@filenames@/: 'P.Nothing'-terminated array of filenames to load
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> m (T.Text)
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
clientLoadConnections :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsClient a, IsCancellable b) =>
a -> [Text] -> Maybe b -> m Text
clientLoadConnections a
client [Text]
filenames Maybe b
cancellable = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr (Ptr CChar)
filenames' <- [Text] -> IO (Ptr (Ptr CChar))
packZeroTerminatedUTF8CArray [Text]
filenames
    Ptr (Ptr CChar)
failures <- IO (Ptr (Ptr CChar))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr CString)
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO Text -> IO () -> IO Text
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Client
-> Ptr (Ptr CChar)
-> Ptr (Ptr CChar)
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
nm_client_load_connections Ptr Client
client' Ptr (Ptr CChar)
filenames' Ptr (Ptr CChar)
failures Ptr Cancellable
maybeCancellable
        Ptr CChar
failures' <- Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
failures
        Text
failures'' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
failures'
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
failures'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        (Ptr CChar -> IO ()) -> Ptr (Ptr CChar) -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr CChar)
filenames'
        Ptr (Ptr CChar) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr CChar)
filenames'
        Ptr (Ptr CChar) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr CChar)
failures
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
failures''
     ) (do
        (Ptr CChar -> IO ()) -> Ptr (Ptr CChar) -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr CChar)
filenames'
        Ptr (Ptr CChar) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr CChar)
filenames'
        Ptr (Ptr CChar) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr CChar)
failures
     )

#if defined(ENABLE_OVERLOADING)
data ClientLoadConnectionsMethodInfo
instance (signature ~ ([T.Text] -> Maybe (b) -> m (T.Text)), MonadIO m, IsClient a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod ClientLoadConnectionsMethodInfo a signature where
    overloadedMethod = clientLoadConnections

instance O.OverloadedMethodInfo ClientLoadConnectionsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientLoadConnections",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientLoadConnections"
        })


#endif

-- method Client::load_connections_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the %NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "filenames"
--           , argType = TCArray True (-1) (-1) (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%NULL-terminated array of filenames to load"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "callback to be called when the operation completes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 4
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "caller-specific data passed to @callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_load_connections_async" nm_client_load_connections_async :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    Ptr CString ->                          -- filenames : TCArray True (-1) (-1) (TBasicType TUTF8)
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Requests that the remote settings service asynchronously load or reload the
-- given files, adding or updating the connections described within.
-- 
-- See 'GI.NM.Objects.Client.clientLoadConnections' for more details.
clientLoadConnectionsAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@client@/: the @/NMClient/@
    -> [T.Text]
    -- ^ /@filenames@/: 'P.Nothing'-terminated array of filenames to load
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: callback to be called when the operation completes
    -> m ()
clientLoadConnectionsAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsClient a, IsCancellable b) =>
a -> [Text] -> Maybe b -> Maybe AsyncReadyCallback -> m ()
clientLoadConnectionsAsync a
client [Text]
filenames Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr (Ptr CChar)
filenames' <- [Text] -> IO (Ptr (Ptr CChar))
packZeroTerminatedUTF8CArray [Text]
filenames
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Client
-> Ptr (Ptr CChar)
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
nm_client_load_connections_async Ptr Client
client' Ptr (Ptr CChar)
filenames' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    (Ptr CChar -> IO ()) -> Ptr (Ptr CChar) -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr CChar)
filenames'
    Ptr (Ptr CChar) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr CChar)
filenames'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ClientLoadConnectionsAsyncMethodInfo
instance (signature ~ ([T.Text] -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsClient a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod ClientLoadConnectionsAsyncMethodInfo a signature where
    overloadedMethod = clientLoadConnectionsAsync

instance O.OverloadedMethodInfo ClientLoadConnectionsAsyncMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientLoadConnectionsAsync",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientLoadConnectionsAsync"
        })


#endif

-- method Client::load_connections_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the %NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "failures"
--           , argType = TCArray True (-1) (-1) (TBasicType TUTF8)
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "on return, a\n   %NULL-terminated array of filenames that failed to load"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the result passed to the #GAsyncReadyCallback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "nm_client_load_connections_finish" nm_client_load_connections_finish :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    Ptr (Ptr CString) ->                    -- failures : TCArray True (-1) (-1) (TBasicType TUTF8)
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Gets the result of an 'GI.NM.Objects.Client.clientLoadConnectionsAsync' call.
-- 
-- See 'GI.NM.Objects.Client.clientLoadConnections' for more details.
clientLoadConnectionsFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@client@/: the @/NMClient/@
    -> b
    -- ^ /@result@/: the result passed to the t'GI.Gio.Callbacks.AsyncReadyCallback'
    -> m ([T.Text])
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
clientLoadConnectionsFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsClient a, IsAsyncResult b) =>
a -> b -> m [Text]
clientLoadConnectionsFinish a
client b
result_ = IO [Text] -> m [Text]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Text] -> m [Text]) -> IO [Text] -> m [Text]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr (Ptr (Ptr CChar))
failures <- IO (Ptr (Ptr (Ptr CChar)))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr CString))
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO [Text] -> IO () -> IO [Text]
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Client
-> Ptr (Ptr (Ptr CChar))
-> Ptr AsyncResult
-> Ptr (Ptr GError)
-> IO CInt
nm_client_load_connections_finish Ptr Client
client' Ptr (Ptr (Ptr CChar))
failures Ptr AsyncResult
result_'
        Ptr (Ptr CChar)
failures' <- Ptr (Ptr (Ptr CChar)) -> IO (Ptr (Ptr CChar))
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr (Ptr CChar))
failures
        [Text]
failures'' <- HasCallStack => Ptr (Ptr CChar) -> IO [Text]
Ptr (Ptr CChar) -> IO [Text]
unpackZeroTerminatedUTF8CArray Ptr (Ptr CChar)
failures'
        (Ptr CChar -> IO ()) -> Ptr (Ptr CChar) -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr CChar)
failures'
        Ptr (Ptr CChar) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr CChar)
failures'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        Ptr (Ptr (Ptr CChar)) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr (Ptr CChar))
failures
        [Text] -> IO [Text]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
failures''
     ) (do
        Ptr (Ptr (Ptr CChar)) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr (Ptr CChar))
failures
     )

#if defined(ENABLE_OVERLOADING)
data ClientLoadConnectionsFinishMethodInfo
instance (signature ~ (b -> m ([T.Text])), MonadIO m, IsClient a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod ClientLoadConnectionsFinishMethodInfo a signature where
    overloadedMethod = clientLoadConnectionsFinish

instance O.OverloadedMethodInfo ClientLoadConnectionsFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientLoadConnectionsFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientLoadConnectionsFinish"
        })


#endif

-- method Client::networking_get_enabled
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_networking_get_enabled" nm_client_networking_get_enabled :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    IO CInt

-- | Whether networking is enabled or disabled.
clientNetworkingGetEnabled ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a) =>
    a
    -- ^ /@client@/: a t'GI.NM.Objects.Client.Client'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if networking is enabled, 'P.False' if networking is disabled
clientNetworkingGetEnabled :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClient a) =>
a -> m Bool
clientNetworkingGetEnabled a
client = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    CInt
result <- Ptr Client -> IO CInt
nm_client_networking_get_enabled Ptr Client
client'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ClientNetworkingGetEnabledMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsClient a) => O.OverloadedMethod ClientNetworkingGetEnabledMethodInfo a signature where
    overloadedMethod = clientNetworkingGetEnabled

instance O.OverloadedMethodInfo ClientNetworkingGetEnabledMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientNetworkingGetEnabled",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientNetworkingGetEnabled"
        })


#endif

-- method Client::networking_set_enabled
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "enabled"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "%TRUE to set networking enabled, %FALSE to set networking disabled"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "nm_client_networking_set_enabled" nm_client_networking_set_enabled :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    CInt ->                                 -- enabled : TBasicType TBoolean
    Ptr (Ptr GError) ->                     -- error
    IO CInt

{-# DEPRECATED clientNetworkingSetEnabled ["(Since version 1.22)","Use the async command 'GI.NM.Objects.Client.clientDbusCall' on 'GI.NM.Constants.DBUS_PATH',","'GI.NM.Constants.DBUS_INTERFACE' to call \\\"Enable\\\" with \\\"(b)\\\" arguments and no return value."] #-}
-- | Enables or disables networking.  When networking is disabled, all controlled
-- interfaces are disconnected and deactivated.  When networking is enabled,
-- all controlled interfaces are available for activation.
clientNetworkingSetEnabled ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a) =>
    a
    -- ^ /@client@/: a t'GI.NM.Objects.Client.Client'
    -> Bool
    -- ^ /@enabled@/: 'P.True' to set networking enabled, 'P.False' to set networking disabled
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
clientNetworkingSetEnabled :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClient a) =>
a -> Bool -> m ()
clientNetworkingSetEnabled a
client Bool
enabled = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    let enabled' :: CInt
enabled' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
enabled
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Client -> CInt -> Ptr (Ptr GError) -> IO CInt
nm_client_networking_set_enabled Ptr Client
client' CInt
enabled'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data ClientNetworkingSetEnabledMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsClient a) => O.OverloadedMethod ClientNetworkingSetEnabledMethodInfo a signature where
    overloadedMethod = clientNetworkingSetEnabled

instance O.OverloadedMethodInfo ClientNetworkingSetEnabledMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientNetworkingSetEnabled",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientNetworkingSetEnabled"
        })


#endif

-- method Client::reload
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the %NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "ManagerReloadFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "flags indicating what to reload."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "callback to be called when the add operation completes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 4
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "caller-specific data passed to @callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_reload" nm_client_reload :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "NM", name = "ManagerReloadFlags"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Reload NetworkManager\'s configuration and perform certain updates, like
-- flushing caches or rewriting external state to disk. This is similar to
-- sending SIGHUP to NetworkManager but it allows for more fine-grained control
-- over what to reload (see /@flags@/). It also allows non-root access via
-- PolicyKit and contrary to signals it is synchronous.
-- 
-- /Since: 1.22/
clientReload ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@client@/: the @/NMClient/@
    -> [NM.Flags.ManagerReloadFlags]
    -- ^ /@flags@/: flags indicating what to reload.
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: callback to be called when the add operation completes
    -> m ()
clientReload :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsClient a, IsCancellable b) =>
a
-> [ManagerReloadFlags]
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
clientReload a
client [ManagerReloadFlags]
flags Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    let flags' :: CUInt
flags' = [ManagerReloadFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [ManagerReloadFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Client
-> CUInt
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
nm_client_reload Ptr Client
client' CUInt
flags' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ClientReloadMethodInfo
instance (signature ~ ([NM.Flags.ManagerReloadFlags] -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsClient a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod ClientReloadMethodInfo a signature where
    overloadedMethod = clientReload

instance O.OverloadedMethodInfo ClientReloadMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientReload",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientReload"
        })


#endif

-- method Client::reload_connections
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "nm_client_reload_connections" nm_client_reload_connections :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

{-# DEPRECATED clientReloadConnections ["(Since version 1.22)","Use 'GI.NM.Objects.Client.clientReloadConnectionsAsync' or GDBusConnection."] #-}
-- | Requests that the remote settings service reload all connection
-- files from disk, adding, updating, and removing connections until
-- the in-memory state matches the on-disk state.
clientReloadConnections ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@client@/: the t'GI.NM.Objects.Client.Client'
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
clientReloadConnections :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsClient a, IsCancellable b) =>
a -> Maybe b -> m ()
clientReloadConnections a
client Maybe b
cancellable = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Client -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
nm_client_reload_connections Ptr Client
client' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data ClientReloadConnectionsMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsClient a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod ClientReloadConnectionsMethodInfo a signature where
    overloadedMethod = clientReloadConnections

instance O.OverloadedMethodInfo ClientReloadConnectionsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientReloadConnections",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientReloadConnections"
        })


#endif

-- method Client::reload_connections_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "callback to be called when the reload operation completes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 3
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "caller-specific data passed to @callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_reload_connections_async" nm_client_reload_connections_async :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Requests that the remote settings service begin reloading all connection
-- files from disk, adding, updating, and removing connections until the
-- in-memory state matches the on-disk state.
clientReloadConnectionsAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@client@/: the t'GI.NM.Objects.Client.Client'
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: callback to be called when the reload operation completes
    -> m ()
clientReloadConnectionsAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsClient a, IsCancellable b) =>
a -> Maybe b -> Maybe AsyncReadyCallback -> m ()
clientReloadConnectionsAsync a
client Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Client
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
nm_client_reload_connections_async Ptr Client
client' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ClientReloadConnectionsAsyncMethodInfo
instance (signature ~ (Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsClient a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod ClientReloadConnectionsAsyncMethodInfo a signature where
    overloadedMethod = clientReloadConnectionsAsync

instance O.OverloadedMethodInfo ClientReloadConnectionsAsyncMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientReloadConnectionsAsync",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientReloadConnectionsAsync"
        })


#endif

-- method Client::reload_connections_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the result passed to the #GAsyncReadyCallback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "nm_client_reload_connections_finish" nm_client_reload_connections_finish :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Gets the result of an 'GI.NM.Objects.Client.clientReloadConnectionsAsync' call.
clientReloadConnectionsFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@client@/: the t'GI.NM.Objects.Client.Client'
    -> b
    -- ^ /@result@/: the result passed to the t'GI.Gio.Callbacks.AsyncReadyCallback'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
clientReloadConnectionsFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsClient a, IsAsyncResult b) =>
a -> b -> m ()
clientReloadConnectionsFinish a
client b
result_ = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Client -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
nm_client_reload_connections_finish Ptr Client
client' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data ClientReloadConnectionsFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsClient a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod ClientReloadConnectionsFinishMethodInfo a signature where
    overloadedMethod = clientReloadConnectionsFinish

instance O.OverloadedMethodInfo ClientReloadConnectionsFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientReloadConnectionsFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientReloadConnectionsFinish"
        })


#endif

-- method Client::reload_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the result passed to the #GAsyncReadyCallback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "nm_client_reload_finish" nm_client_reload_finish :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Gets the result of a call to 'GI.NM.Objects.Client.clientReload'.
-- 
-- /Since: 1.22/
clientReloadFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@client@/: an t'GI.NM.Objects.Client.Client'
    -> b
    -- ^ /@result@/: the result passed to the t'GI.Gio.Callbacks.AsyncReadyCallback'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
clientReloadFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsClient a, IsAsyncResult b) =>
a -> b -> m ()
clientReloadFinish a
client b
result_ = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Client -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
nm_client_reload_finish Ptr Client
client' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data ClientReloadFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsClient a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod ClientReloadFinishMethodInfo a signature where
    overloadedMethod = clientReloadFinish

instance O.OverloadedMethodInfo ClientReloadFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientReloadFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientReloadFinish"
        })


#endif

-- method Client::save_hostname
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the %NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "hostname"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the new persistent hostname to set, or %NULL to\n  clear any existing persistent hostname"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "nm_client_save_hostname" nm_client_save_hostname :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    CString ->                              -- hostname : TBasicType TUTF8
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

{-# DEPRECATED clientSaveHostname ["(Since version 1.22)","Use 'GI.NM.Objects.Client.clientSaveHostnameAsync' or GDBusConnection."] #-}
-- | Requests that the machine\'s persistent hostname be set to the specified value
-- or cleared.
clientSaveHostname ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@client@/: the @/NMClient/@
    -> Maybe (T.Text)
    -- ^ /@hostname@/: the new persistent hostname to set, or 'P.Nothing' to
    --   clear any existing persistent hostname
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
clientSaveHostname :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsClient a, IsCancellable b) =>
a -> Maybe Text -> Maybe b -> m ()
clientSaveHostname a
client Maybe Text
hostname Maybe b
cancellable = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr CChar
maybeHostname <- case Maybe Text
hostname of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
FP.nullPtr
        Just Text
jHostname -> do
            Ptr CChar
jHostname' <- Text -> IO (Ptr CChar)
textToCString Text
jHostname
            Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jHostname'
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Client
-> Ptr CChar -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
nm_client_save_hostname Ptr Client
client' Ptr CChar
maybeHostname Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeHostname
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeHostname
     )

#if defined(ENABLE_OVERLOADING)
data ClientSaveHostnameMethodInfo
instance (signature ~ (Maybe (T.Text) -> Maybe (b) -> m ()), MonadIO m, IsClient a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod ClientSaveHostnameMethodInfo a signature where
    overloadedMethod = clientSaveHostname

instance O.OverloadedMethodInfo ClientSaveHostnameMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientSaveHostname",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientSaveHostname"
        })


#endif

-- method Client::save_hostname_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the %NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "hostname"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the new persistent hostname to set, or %NULL to\n  clear any existing persistent hostname"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "callback to be called when the operation completes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 4
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "caller-specific data passed to @callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_save_hostname_async" nm_client_save_hostname_async :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    CString ->                              -- hostname : TBasicType TUTF8
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Requests that the machine\'s persistent hostname be set to the specified value
-- or cleared.
clientSaveHostnameAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@client@/: the @/NMClient/@
    -> Maybe (T.Text)
    -- ^ /@hostname@/: the new persistent hostname to set, or 'P.Nothing' to
    --   clear any existing persistent hostname
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: callback to be called when the operation completes
    -> m ()
clientSaveHostnameAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsClient a, IsCancellable b) =>
a -> Maybe Text -> Maybe b -> Maybe AsyncReadyCallback -> m ()
clientSaveHostnameAsync a
client Maybe Text
hostname Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr CChar
maybeHostname <- case Maybe Text
hostname of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
FP.nullPtr
        Just Text
jHostname -> do
            Ptr CChar
jHostname' <- Text -> IO (Ptr CChar)
textToCString Text
jHostname
            Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jHostname'
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Client
-> Ptr CChar
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
nm_client_save_hostname_async Ptr Client
client' Ptr CChar
maybeHostname Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeHostname
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ClientSaveHostnameAsyncMethodInfo
instance (signature ~ (Maybe (T.Text) -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsClient a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod ClientSaveHostnameAsyncMethodInfo a signature where
    overloadedMethod = clientSaveHostnameAsync

instance O.OverloadedMethodInfo ClientSaveHostnameAsyncMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientSaveHostnameAsync",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientSaveHostnameAsync"
        })


#endif

-- method Client::save_hostname_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the %NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the result passed to the #GAsyncReadyCallback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "nm_client_save_hostname_finish" nm_client_save_hostname_finish :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Gets the result of an 'GI.NM.Objects.Client.clientSaveHostnameAsync' call.
clientSaveHostnameFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@client@/: the @/NMClient/@
    -> b
    -- ^ /@result@/: the result passed to the t'GI.Gio.Callbacks.AsyncReadyCallback'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
clientSaveHostnameFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsClient a, IsAsyncResult b) =>
a -> b -> m ()
clientSaveHostnameFinish a
client b
result_ = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Client -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
nm_client_save_hostname_finish Ptr Client
client' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data ClientSaveHostnameFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsClient a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod ClientSaveHostnameFinishMethodInfo a signature where
    overloadedMethod = clientSaveHostnameFinish

instance O.OverloadedMethodInfo ClientSaveHostnameFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientSaveHostnameFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientSaveHostnameFinish"
        })


#endif

-- method Client::set_logging
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "level"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "logging level to set (%NULL or an empty string for no change)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "domains"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "logging domains to set. The string should be a list of log\n  domains separated by \",\". (%NULL or an empty string for no change)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "nm_client_set_logging" nm_client_set_logging :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    CString ->                              -- level : TBasicType TUTF8
    CString ->                              -- domains : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO CInt

{-# DEPRECATED clientSetLogging ["(Since version 1.22)","Use the async command 'GI.NM.Objects.Client.clientDbusCall' on 'GI.NM.Constants.DBUS_PATH',","'GI.NM.Constants.DBUS_INTERFACE' to call \\\"SetLogging\\\" with \\\"(ss)\\\" arguments for level and domains."] #-}
-- | Sets NetworkManager logging level and\/or domains.
clientSetLogging ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a) =>
    a
    -- ^ /@client@/: a t'GI.NM.Objects.Client.Client'
    -> Maybe (T.Text)
    -- ^ /@level@/: logging level to set ('P.Nothing' or an empty string for no change)
    -> Maybe (T.Text)
    -- ^ /@domains@/: logging domains to set. The string should be a list of log
    --   domains separated by \",\". ('P.Nothing' or an empty string for no change)
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
clientSetLogging :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClient a) =>
a -> Maybe Text -> Maybe Text -> m ()
clientSetLogging a
client Maybe Text
level Maybe Text
domains = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    Ptr CChar
maybeLevel <- case Maybe Text
level of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
FP.nullPtr
        Just Text
jLevel -> do
            Ptr CChar
jLevel' <- Text -> IO (Ptr CChar)
textToCString Text
jLevel
            Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jLevel'
    Ptr CChar
maybeDomains <- case Maybe Text
domains of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
FP.nullPtr
        Just Text
jDomains -> do
            Ptr CChar
jDomains' <- Text -> IO (Ptr CChar)
textToCString Text
jDomains
            Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jDomains'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Client -> Ptr CChar -> Ptr CChar -> Ptr (Ptr GError) -> IO CInt
nm_client_set_logging Ptr Client
client' Ptr CChar
maybeLevel Ptr CChar
maybeDomains
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeLevel
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeDomains
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeLevel
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeDomains
     )

#if defined(ENABLE_OVERLOADING)
data ClientSetLoggingMethodInfo
instance (signature ~ (Maybe (T.Text) -> Maybe (T.Text) -> m ()), MonadIO m, IsClient a) => O.OverloadedMethod ClientSetLoggingMethodInfo a signature where
    overloadedMethod = clientSetLogging

instance O.OverloadedMethodInfo ClientSetLoggingMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientSetLogging",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientSetLogging"
        })


#endif

-- method Client::wait_shutdown
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMClient to shutdown."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "integrate_maincontext"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "whether to hook the client's maincontext\n  in the current thread default. Otherwise, you must ensure\n  that the client's maincontext gets iterated so that it can complete.\n  By integrating the maincontext in the current thread default, you\n  may instead only iterate the latter."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GCancellable to abort the shutdown."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #GAsyncReadyCallback to call when the request\n  is satisfied or %NULL if you don't care about the result of the\n  method invocation."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 4
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to pass to @callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_wait_shutdown" nm_client_wait_shutdown :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    CInt ->                                 -- integrate_maincontext : TBasicType TBoolean
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | The way to stop t'GI.NM.Objects.Client.Client' is by unrefing it. That will cancel all
-- internally pending async operations. However, as async operations in
-- NMClient use GTask, hence they cannot complete right away. Instead,
-- their (internal) result callback still needs to be dispatched by iterating
-- the client\'s main context.
-- 
-- You thus cannot stop iterating the client\'s main context until
-- everything is wrapped up. 'GI.NM.Objects.Client.clientGetContextBusyWatcher'
-- helps to watch how long that will be.
-- 
-- This function automates that waiting. Like all glib async operations
-- this honors the current 'GI.GLib.Functions.mainContextGetThreadDefault'.
-- 
-- In any case, to complete the shutdown, 'GI.NM.Objects.Client.clientGetMainContext'
-- must be iterated. If the current 'GI.GLib.Functions.mainContextGetThreadDefault' is
-- the same as 'GI.NM.Objects.Client.clientGetMainContext', then /@integrateMaincontext@/
-- is ignored. In that case, the caller is required to iterate the context
-- for shutdown to complete. Otherwise, if 'GI.GLib.Functions.mainContextGetThreadDefault'
-- differs from 'GI.NM.Objects.Client.clientGetMainContext' and /@integrateMaincontext@/
-- is 'P.False', the caller must make sure that both contexts are iterated
-- until completion. Otherwise, if /@integrateMaincontext@/ is 'P.True', then
-- 'GI.NM.Objects.Client.clientGetMainContext' will be integrated in 'GI.GLib.Functions.mainContextGetThreadDefault'.
-- This means, the caller gives 'GI.NM.Objects.Client.clientGetMainContext' up until the waiting
-- completes, the function will acquire the context and hook it into
-- 'GI.GLib.Functions.mainContextGetThreadDefault'.
-- It is a bug to request /@integrateMaincontext@/ while having 'GI.NM.Objects.Client.clientGetMainContext'
-- acquired or iterated otherwise because a context can only be acquired once
-- at a time.
-- 
-- Shutdown can only complete after all references to /@client@/ were released.
-- 
-- It is possible to call this function multiple times for the same client.
-- But note that with /@integrateMaincontext@/ the client\'s context is acquired,
-- which can only be done once at a time.
-- 
-- It is permissible to start waiting before the objects is fully initialized.
-- 
-- The function really allows two separate things. To get a notification (callback) when
-- shutdown is complete, and to integrate the client\'s context in another context.
-- The latter case is useful if the client has a separate context and you hand it
-- over to another GMainContext to wrap up.
-- 
-- The main use is to have a NMClient and a separate GMainContext on a worker
-- thread. When being done, you can hand over the cleanup of the context
-- to 'GI.GLib.Functions.mainContextDefault', assuming that the main thread iterates
-- the default context. In that case, you don\'t need to care about passing
-- a callback to know when shutdown completed.
-- 
-- /Since: 1.42/
clientWaitShutdown ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@client@/: the t'GI.NM.Objects.Client.Client' to shutdown.
    -> Bool
    -- ^ /@integrateMaincontext@/: whether to hook the client\'s maincontext
    --   in the current thread default. Otherwise, you must ensure
    --   that the client\'s maincontext gets iterated so that it can complete.
    --   By integrating the maincontext in the current thread default, you
    --   may instead only iterate the latter.
    -> Maybe (b)
    -- ^ /@cancellable@/: the t'GI.Gio.Objects.Cancellable.Cancellable' to abort the shutdown.
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback' to call when the request
    --   is satisfied or 'P.Nothing' if you don\'t care about the result of the
    --   method invocation.
    -> m ()
clientWaitShutdown :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsClient a, IsCancellable b) =>
a -> Bool -> Maybe b -> Maybe AsyncReadyCallback -> m ()
clientWaitShutdown a
client Bool
integrateMaincontext Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    let integrateMaincontext' :: CInt
integrateMaincontext' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
integrateMaincontext
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Client
-> CInt
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
nm_client_wait_shutdown Ptr Client
client' CInt
integrateMaincontext' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ClientWaitShutdownMethodInfo
instance (signature ~ (Bool -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsClient a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod ClientWaitShutdownMethodInfo a signature where
    overloadedMethod = clientWaitShutdown

instance O.OverloadedMethodInfo ClientWaitShutdownMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientWaitShutdown",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientWaitShutdown"
        })


#endif

-- method Client::wimax_get_enabled
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_wimax_get_enabled" nm_client_wimax_get_enabled :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    IO CInt

{-# DEPRECATED clientWimaxGetEnabled ["(Since version 1.22)","This function always returns FALSE because WiMax is no longer supported."] #-}
-- | Determines whether WiMAX is enabled.
clientWimaxGetEnabled ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a) =>
    a
    -- ^ /@client@/: a t'GI.NM.Objects.Client.Client'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if WiMAX is enabled
clientWimaxGetEnabled :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClient a) =>
a -> m Bool
clientWimaxGetEnabled a
client = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    CInt
result <- Ptr Client -> IO CInt
nm_client_wimax_get_enabled Ptr Client
client'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ClientWimaxGetEnabledMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsClient a) => O.OverloadedMethod ClientWimaxGetEnabledMethodInfo a signature where
    overloadedMethod = clientWimaxGetEnabled

instance O.OverloadedMethodInfo ClientWimaxGetEnabledMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientWimaxGetEnabled",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientWimaxGetEnabled"
        })


#endif

-- method Client::wimax_hardware_get_enabled
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_wimax_hardware_get_enabled" nm_client_wimax_hardware_get_enabled :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    IO CInt

{-# DEPRECATED clientWimaxHardwareGetEnabled ["(Since version 1.22)","This function always returns FALSE because WiMax is no longer supported."] #-}
-- | Determines whether the WiMAX hardware is enabled.
clientWimaxHardwareGetEnabled ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a) =>
    a
    -- ^ /@client@/: a t'GI.NM.Objects.Client.Client'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the WiMAX hardware is enabled
clientWimaxHardwareGetEnabled :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClient a) =>
a -> m Bool
clientWimaxHardwareGetEnabled a
client = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    CInt
result <- Ptr Client -> IO CInt
nm_client_wimax_hardware_get_enabled Ptr Client
client'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ClientWimaxHardwareGetEnabledMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsClient a) => O.OverloadedMethod ClientWimaxHardwareGetEnabledMethodInfo a signature where
    overloadedMethod = clientWimaxHardwareGetEnabled

instance O.OverloadedMethodInfo ClientWimaxHardwareGetEnabledMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientWimaxHardwareGetEnabled",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientWimaxHardwareGetEnabled"
        })


#endif

-- method Client::wimax_set_enabled
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "enabled"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE to enable WiMAX"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_wimax_set_enabled" nm_client_wimax_set_enabled :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    CInt ->                                 -- enabled : TBasicType TBoolean
    IO ()

{-# DEPRECATED clientWimaxSetEnabled ["(Since version 1.22)","This function does nothing because WiMax is no longer supported."] #-}
-- | Enables or disables WiMAX devices.
clientWimaxSetEnabled ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a) =>
    a
    -- ^ /@client@/: a t'GI.NM.Objects.Client.Client'
    -> Bool
    -- ^ /@enabled@/: 'P.True' to enable WiMAX
    -> m ()
clientWimaxSetEnabled :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClient a) =>
a -> Bool -> m ()
clientWimaxSetEnabled a
client Bool
enabled = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    let enabled' :: CInt
enabled' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
enabled
    Ptr Client -> CInt -> IO ()
nm_client_wimax_set_enabled Ptr Client
client' CInt
enabled'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ClientWimaxSetEnabledMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsClient a) => O.OverloadedMethod ClientWimaxSetEnabledMethodInfo a signature where
    overloadedMethod = clientWimaxSetEnabled

instance O.OverloadedMethodInfo ClientWimaxSetEnabledMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientWimaxSetEnabled",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientWimaxSetEnabled"
        })


#endif

-- method Client::wireless_get_enabled
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_wireless_get_enabled" nm_client_wireless_get_enabled :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    IO CInt

-- | Determines whether the wireless is enabled.
clientWirelessGetEnabled ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a) =>
    a
    -- ^ /@client@/: a t'GI.NM.Objects.Client.Client'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if wireless is enabled
clientWirelessGetEnabled :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClient a) =>
a -> m Bool
clientWirelessGetEnabled a
client = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    CInt
result <- Ptr Client -> IO CInt
nm_client_wireless_get_enabled Ptr Client
client'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ClientWirelessGetEnabledMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsClient a) => O.OverloadedMethod ClientWirelessGetEnabledMethodInfo a signature where
    overloadedMethod = clientWirelessGetEnabled

instance O.OverloadedMethodInfo ClientWirelessGetEnabledMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientWirelessGetEnabled",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientWirelessGetEnabled"
        })


#endif

-- method Client::wireless_hardware_get_enabled
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_wireless_hardware_get_enabled" nm_client_wireless_hardware_get_enabled :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    IO CInt

-- | Determines whether the wireless hardware is enabled.
clientWirelessHardwareGetEnabled ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a) =>
    a
    -- ^ /@client@/: a t'GI.NM.Objects.Client.Client'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the wireless hardware is enabled
clientWirelessHardwareGetEnabled :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClient a) =>
a -> m Bool
clientWirelessHardwareGetEnabled a
client = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    CInt
result <- Ptr Client -> IO CInt
nm_client_wireless_hardware_get_enabled Ptr Client
client'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ClientWirelessHardwareGetEnabledMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsClient a) => O.OverloadedMethod ClientWirelessHardwareGetEnabledMethodInfo a signature where
    overloadedMethod = clientWirelessHardwareGetEnabled

instance O.OverloadedMethodInfo ClientWirelessHardwareGetEnabledMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientWirelessHardwareGetEnabled",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientWirelessHardwareGetEnabled"
        })


#endif

-- method Client::wireless_set_enabled
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "enabled"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE to enable wireless"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_wireless_set_enabled" nm_client_wireless_set_enabled :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    CInt ->                                 -- enabled : TBasicType TBoolean
    IO ()

{-# DEPRECATED clientWirelessSetEnabled ["(Since version 1.22)","Use the async command 'GI.NM.Objects.Client.clientDbusSetProperty' on 'GI.NM.Constants.DBUS_PATH',","'GI.NM.Constants.DBUS_INTERFACE' to set \\\"WirelessEnabled\\\" property to a \\\"(b)\\\" value."] #-}
-- | Enables or disables wireless devices.
clientWirelessSetEnabled ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a) =>
    a
    -- ^ /@client@/: a t'GI.NM.Objects.Client.Client'
    -> Bool
    -- ^ /@enabled@/: 'P.True' to enable wireless
    -> m ()
clientWirelessSetEnabled :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClient a) =>
a -> Bool -> m ()
clientWirelessSetEnabled a
client Bool
enabled = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    let enabled' :: CInt
enabled' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
enabled
    Ptr Client -> CInt -> IO ()
nm_client_wireless_set_enabled Ptr Client
client' CInt
enabled'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ClientWirelessSetEnabledMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsClient a) => O.OverloadedMethod ClientWirelessSetEnabledMethodInfo a signature where
    overloadedMethod = clientWirelessSetEnabled

instance O.OverloadedMethodInfo ClientWirelessSetEnabledMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientWirelessSetEnabled",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientWirelessSetEnabled"
        })


#endif

-- method Client::wwan_get_enabled
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_wwan_get_enabled" nm_client_wwan_get_enabled :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    IO CInt

-- | Determines whether WWAN is enabled.
clientWwanGetEnabled ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a) =>
    a
    -- ^ /@client@/: a t'GI.NM.Objects.Client.Client'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if WWAN is enabled
clientWwanGetEnabled :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClient a) =>
a -> m Bool
clientWwanGetEnabled a
client = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    CInt
result <- Ptr Client -> IO CInt
nm_client_wwan_get_enabled Ptr Client
client'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ClientWwanGetEnabledMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsClient a) => O.OverloadedMethod ClientWwanGetEnabledMethodInfo a signature where
    overloadedMethod = clientWwanGetEnabled

instance O.OverloadedMethodInfo ClientWwanGetEnabledMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientWwanGetEnabled",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientWwanGetEnabled"
        })


#endif

-- method Client::wwan_hardware_get_enabled
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_wwan_hardware_get_enabled" nm_client_wwan_hardware_get_enabled :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    IO CInt

-- | Determines whether the WWAN hardware is enabled.
clientWwanHardwareGetEnabled ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a) =>
    a
    -- ^ /@client@/: a t'GI.NM.Objects.Client.Client'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the WWAN hardware is enabled
clientWwanHardwareGetEnabled :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClient a) =>
a -> m Bool
clientWwanHardwareGetEnabled a
client = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    CInt
result <- Ptr Client -> IO CInt
nm_client_wwan_hardware_get_enabled Ptr Client
client'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ClientWwanHardwareGetEnabledMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsClient a) => O.OverloadedMethod ClientWwanHardwareGetEnabledMethodInfo a signature where
    overloadedMethod = clientWwanHardwareGetEnabled

instance O.OverloadedMethodInfo ClientWwanHardwareGetEnabledMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientWwanHardwareGetEnabled",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientWwanHardwareGetEnabled"
        })


#endif

-- method Client::wwan_set_enabled
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "client"
--           , argType = TInterface Name { namespace = "NM" , name = "Client" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #NMClient" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "enabled"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE to enable WWAN"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_wwan_set_enabled" nm_client_wwan_set_enabled :: 
    Ptr Client ->                           -- client : TInterface (Name {namespace = "NM", name = "Client"})
    CInt ->                                 -- enabled : TBasicType TBoolean
    IO ()

{-# DEPRECATED clientWwanSetEnabled ["(Since version 1.22)","Use the async command 'GI.NM.Objects.Client.clientDbusSetProperty' on 'GI.NM.Constants.DBUS_PATH',","'GI.NM.Constants.DBUS_INTERFACE' to set \\\"WwanEnabled\\\" property to a \\\"(b)\\\" value."] #-}
-- | Enables or disables WWAN devices.
clientWwanSetEnabled ::
    (B.CallStack.HasCallStack, MonadIO m, IsClient a) =>
    a
    -- ^ /@client@/: a t'GI.NM.Objects.Client.Client'
    -> Bool
    -- ^ /@enabled@/: 'P.True' to enable WWAN
    -> m ()
clientWwanSetEnabled :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClient a) =>
a -> Bool -> m ()
clientWwanSetEnabled a
client Bool
enabled = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Client
client' <- a -> IO (Ptr Client)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
client
    let enabled' :: CInt
enabled' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
enabled
    Ptr Client -> CInt -> IO ()
nm_client_wwan_set_enabled Ptr Client
client' CInt
enabled'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
client
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ClientWwanSetEnabledMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsClient a) => O.OverloadedMethod ClientWwanSetEnabledMethodInfo a signature where
    overloadedMethod = clientWwanSetEnabled

instance O.OverloadedMethodInfo ClientWwanSetEnabledMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.Client.clientWwanSetEnabled",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-Client.html#v:clientWwanSetEnabled"
        })


#endif

-- method Client::new_async
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "callback to call when the client is created"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data for @callback" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "nm_client_new_async" nm_client_new_async :: 
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Creates a new t'GI.NM.Objects.Client.Client' asynchronously.
-- /@callback@/ will be called when it is done. Use
-- 'GI.NM.Objects.Client.clientNewFinish' to get the result.
-- 
-- This does nothing beside calling @/g_async_initable_new_async()/@. You are free to
-- call @/g_async_initable_new_async()/@ or @/g_object_new()/@\/'GI.Gio.Interfaces.AsyncInitable.asyncInitableInitAsync'
-- directly for more control, to set GObject properties or get access to the NMClient
-- instance while it is still initializing.
-- 
-- Creating an t'GI.NM.Objects.Client.Client' instance can only fail for two reasons. First, if you didn\'t
-- provide a 'GI.NM.Constants.CLIENT_DBUS_CONNECTION' and the call to 'GI.Gio.Functions.busGet'
-- fails. You can avoid that by using @/g_async_initable_new_async()/@ directly and
-- set a D-Bus connection.
-- Second, if you cancelled the creation. If you do that, then note
-- that after the failure there might still be idle actions pending
-- which keep 'GI.NM.Objects.Client.clientGetMainContext' alive. That means,
-- in that case you must continue iterating the context to avoid
-- leaks. See 'GI.NM.Objects.Client.clientGetContextBusyWatcher'.
-- 
-- Creating an t'GI.NM.Objects.Client.Client' instance when NetworkManager is not running
-- does not cause a failure.
clientNewAsync ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.Cancellable.IsCancellable a) =>
    Maybe (a)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: callback to call when the client is created
    -> m ()
clientNewAsync :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCancellable a) =>
Maybe a -> Maybe AsyncReadyCallback -> m ()
clientNewAsync Maybe a
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Cancellable
maybeCancellable <- case Maybe a
cancellable of
        Maybe a
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just a
jCancellable -> do
            Ptr Cancellable
jCancellable' <- a -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Cancellable -> FunPtr C_AsyncReadyCallback -> Ptr () -> IO ()
nm_client_new_async Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
cancellable a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif

-- method Client::wait_shutdown_finish
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #GAsyncResult obtained from the #GAsyncReadyCallback passed to nm_client_wait_shutdown()"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "nm_client_wait_shutdown_finish" nm_client_wait_shutdown_finish :: 
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | /No description available in the introspection data./
-- 
-- /Since: 1.42/
clientWaitShutdownFinish ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.AsyncResult.IsAsyncResult a) =>
    a
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult' obtained from the t'GI.Gio.Callbacks.AsyncReadyCallback' passed to 'GI.NM.Objects.Client.clientWaitShutdown'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
clientWaitShutdownFinish :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAsyncResult a) =>
a -> m ()
clientWaitShutdownFinish a
result_ = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr AsyncResult
result_' <- a -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
result_
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
nm_client_wait_shutdown_finish Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
result_
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
#endif