{-# LANGUAGE ImplicitParams, RankNTypes, TypeApplications #-}
#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif
module GI.NM.Objects.ActiveConnection
(
ActiveConnection(..) ,
IsActiveConnection ,
toActiveConnection ,
#if defined(ENABLE_OVERLOADING)
ResolveActiveConnectionMethod ,
#endif
#if defined(ENABLE_OVERLOADING)
ActiveConnectionGetConnectionMethodInfo ,
#endif
activeConnectionGetConnection ,
#if defined(ENABLE_OVERLOADING)
ActiveConnectionGetConnectionTypeMethodInfo,
#endif
activeConnectionGetConnectionType ,
#if defined(ENABLE_OVERLOADING)
ActiveConnectionGetControllerMethodInfo ,
#endif
activeConnectionGetController ,
#if defined(ENABLE_OVERLOADING)
ActiveConnectionGetDefaultMethodInfo ,
#endif
activeConnectionGetDefault ,
#if defined(ENABLE_OVERLOADING)
ActiveConnectionGetDefault6MethodInfo ,
#endif
activeConnectionGetDefault6 ,
#if defined(ENABLE_OVERLOADING)
ActiveConnectionGetDevicesMethodInfo ,
#endif
activeConnectionGetDevices ,
#if defined(ENABLE_OVERLOADING)
ActiveConnectionGetDhcp4ConfigMethodInfo,
#endif
activeConnectionGetDhcp4Config ,
#if defined(ENABLE_OVERLOADING)
ActiveConnectionGetDhcp6ConfigMethodInfo,
#endif
activeConnectionGetDhcp6Config ,
#if defined(ENABLE_OVERLOADING)
ActiveConnectionGetIdMethodInfo ,
#endif
activeConnectionGetId ,
#if defined(ENABLE_OVERLOADING)
ActiveConnectionGetIp4ConfigMethodInfo ,
#endif
activeConnectionGetIp4Config ,
#if defined(ENABLE_OVERLOADING)
ActiveConnectionGetIp6ConfigMethodInfo ,
#endif
activeConnectionGetIp6Config ,
#if defined(ENABLE_OVERLOADING)
ActiveConnectionGetMasterMethodInfo ,
#endif
activeConnectionGetMaster ,
#if defined(ENABLE_OVERLOADING)
ActiveConnectionGetSpecificObjectPathMethodInfo,
#endif
activeConnectionGetSpecificObjectPath ,
#if defined(ENABLE_OVERLOADING)
ActiveConnectionGetStateMethodInfo ,
#endif
activeConnectionGetState ,
#if defined(ENABLE_OVERLOADING)
ActiveConnectionGetStateFlagsMethodInfo ,
#endif
activeConnectionGetStateFlags ,
#if defined(ENABLE_OVERLOADING)
ActiveConnectionGetStateReasonMethodInfo,
#endif
activeConnectionGetStateReason ,
#if defined(ENABLE_OVERLOADING)
ActiveConnectionGetUuidMethodInfo ,
#endif
activeConnectionGetUuid ,
#if defined(ENABLE_OVERLOADING)
ActiveConnectionGetVpnMethodInfo ,
#endif
activeConnectionGetVpn ,
#if defined(ENABLE_OVERLOADING)
ActiveConnectionConnectionPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
activeConnectionConnection ,
#endif
getActiveConnectionConnection ,
#if defined(ENABLE_OVERLOADING)
ActiveConnectionControllerPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
activeConnectionController ,
#endif
getActiveConnectionController ,
#if defined(ENABLE_OVERLOADING)
ActiveConnectionDefaultPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
activeConnectionDefault ,
#endif
getActiveConnectionDefault ,
#if defined(ENABLE_OVERLOADING)
ActiveConnectionDefault6PropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
activeConnectionDefault6 ,
#endif
getActiveConnectionDefault6 ,
#if defined(ENABLE_OVERLOADING)
ActiveConnectionDevicesPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
activeConnectionDevices ,
#endif
#if defined(ENABLE_OVERLOADING)
ActiveConnectionDhcp4ConfigPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
activeConnectionDhcp4Config ,
#endif
getActiveConnectionDhcp4Config ,
#if defined(ENABLE_OVERLOADING)
ActiveConnectionDhcp6ConfigPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
activeConnectionDhcp6Config ,
#endif
getActiveConnectionDhcp6Config ,
#if defined(ENABLE_OVERLOADING)
ActiveConnectionIdPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
activeConnectionId ,
#endif
getActiveConnectionId ,
#if defined(ENABLE_OVERLOADING)
ActiveConnectionIp4ConfigPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
activeConnectionIp4Config ,
#endif
getActiveConnectionIp4Config ,
#if defined(ENABLE_OVERLOADING)
ActiveConnectionIp6ConfigPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
activeConnectionIp6Config ,
#endif
getActiveConnectionIp6Config ,
#if defined(ENABLE_OVERLOADING)
ActiveConnectionMasterPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
activeConnectionMaster ,
#endif
getActiveConnectionMaster ,
#if defined(ENABLE_OVERLOADING)
ActiveConnectionSpecificObjectPathPropertyInfo,
#endif
#if defined(ENABLE_OVERLOADING)
activeConnectionSpecificObjectPath ,
#endif
getActiveConnectionSpecificObjectPath ,
#if defined(ENABLE_OVERLOADING)
ActiveConnectionStatePropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
activeConnectionState ,
#endif
getActiveConnectionState ,
#if defined(ENABLE_OVERLOADING)
ActiveConnectionStateFlagsPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
activeConnectionStateFlags ,
#endif
getActiveConnectionStateFlags ,
#if defined(ENABLE_OVERLOADING)
ActiveConnectionTypePropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
activeConnectionType ,
#endif
getActiveConnectionType ,
#if defined(ENABLE_OVERLOADING)
ActiveConnectionUuidPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
activeConnectionUuid ,
#endif
getActiveConnectionUuid ,
#if defined(ENABLE_OVERLOADING)
ActiveConnectionVpnPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
activeConnectionVpn ,
#endif
getActiveConnectionVpn ,
ActiveConnectionStateChangedCallback ,
#if defined(ENABLE_OVERLOADING)
ActiveConnectionStateChangedSignalInfo ,
#endif
afterActiveConnectionStateChanged ,
onActiveConnectionStateChanged ,
) 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
#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.Checkpoint as NM.Checkpoint
import {-# SOURCE #-} qualified GI.NM.Objects.Client as NM.Client
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.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.NM.Enums as NM.Enums
import {-# SOURCE #-} qualified GI.NM.Flags as NM.Flags
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
#endif
newtype ActiveConnection = ActiveConnection (SP.ManagedPtr ActiveConnection)
deriving (ActiveConnection -> ActiveConnection -> Bool
(ActiveConnection -> ActiveConnection -> Bool)
-> (ActiveConnection -> ActiveConnection -> Bool)
-> Eq ActiveConnection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ActiveConnection -> ActiveConnection -> Bool
== :: ActiveConnection -> ActiveConnection -> Bool
$c/= :: ActiveConnection -> ActiveConnection -> Bool
/= :: ActiveConnection -> ActiveConnection -> Bool
Eq)
instance SP.ManagedPtrNewtype ActiveConnection where
toManagedPtr :: ActiveConnection -> ManagedPtr ActiveConnection
toManagedPtr (ActiveConnection ManagedPtr ActiveConnection
p) = ManagedPtr ActiveConnection
p
foreign import ccall "nm_active_connection_get_type"
c_nm_active_connection_get_type :: IO B.Types.GType
instance B.Types.TypedObject ActiveConnection where
glibType :: IO GType
glibType = IO GType
c_nm_active_connection_get_type
instance B.Types.GObject ActiveConnection
class (SP.GObject o, O.IsDescendantOf ActiveConnection o) => IsActiveConnection o
instance (SP.GObject o, O.IsDescendantOf ActiveConnection o) => IsActiveConnection o
instance O.HasParentTypes ActiveConnection
type instance O.ParentTypes ActiveConnection = '[NM.Object.Object, GObject.Object.Object]
toActiveConnection :: (MIO.MonadIO m, IsActiveConnection o) => o -> m ActiveConnection
toActiveConnection :: forall (m :: * -> *) o.
(MonadIO m, IsActiveConnection o) =>
o -> m ActiveConnection
toActiveConnection = 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)
-> (o -> IO ActiveConnection) -> o -> m ActiveConnection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr ActiveConnection -> ActiveConnection)
-> o -> IO ActiveConnection
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr ActiveConnection -> ActiveConnection
ActiveConnection
instance B.GValue.IsGValue (Maybe ActiveConnection) where
gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_nm_active_connection_get_type
gvalueSet_ :: Ptr GValue -> Maybe ActiveConnection -> IO ()
gvalueSet_ Ptr GValue
gv Maybe ActiveConnection
P.Nothing = Ptr GValue -> Ptr ActiveConnection -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr ActiveConnection
forall a. Ptr a
FP.nullPtr :: FP.Ptr ActiveConnection)
gvalueSet_ Ptr GValue
gv (P.Just ActiveConnection
obj) = ActiveConnection -> (Ptr ActiveConnection -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr ActiveConnection
obj (Ptr GValue -> Ptr ActiveConnection -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
gvalueGet_ :: Ptr GValue -> IO (Maybe ActiveConnection)
gvalueGet_ Ptr GValue
gv = do
Ptr ActiveConnection
ptr <- Ptr GValue -> IO (Ptr ActiveConnection)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr ActiveConnection)
if Ptr ActiveConnection
ptr Ptr ActiveConnection -> Ptr ActiveConnection -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr ActiveConnection
forall a. Ptr a
FP.nullPtr
then ActiveConnection -> Maybe ActiveConnection
forall a. a -> Maybe a
P.Just (ActiveConnection -> Maybe ActiveConnection)
-> IO ActiveConnection -> IO (Maybe ActiveConnection)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr ActiveConnection -> ActiveConnection)
-> Ptr ActiveConnection -> IO ActiveConnection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr ActiveConnection -> ActiveConnection
ActiveConnection Ptr ActiveConnection
ptr
else Maybe ActiveConnection -> IO (Maybe ActiveConnection)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ActiveConnection
forall a. Maybe a
P.Nothing
#if defined(ENABLE_OVERLOADING)
type family ResolveActiveConnectionMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
ResolveActiveConnectionMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
ResolveActiveConnectionMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
ResolveActiveConnectionMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
ResolveActiveConnectionMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
ResolveActiveConnectionMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
ResolveActiveConnectionMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
ResolveActiveConnectionMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
ResolveActiveConnectionMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
ResolveActiveConnectionMethod "ref" o = GObject.Object.ObjectRefMethodInfo
ResolveActiveConnectionMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
ResolveActiveConnectionMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
ResolveActiveConnectionMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
ResolveActiveConnectionMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
ResolveActiveConnectionMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
ResolveActiveConnectionMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
ResolveActiveConnectionMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
ResolveActiveConnectionMethod "getClient" o = NM.Object.ObjectGetClientMethodInfo
ResolveActiveConnectionMethod "getConnection" o = ActiveConnectionGetConnectionMethodInfo
ResolveActiveConnectionMethod "getConnectionType" o = ActiveConnectionGetConnectionTypeMethodInfo
ResolveActiveConnectionMethod "getController" o = ActiveConnectionGetControllerMethodInfo
ResolveActiveConnectionMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
ResolveActiveConnectionMethod "getDefault" o = ActiveConnectionGetDefaultMethodInfo
ResolveActiveConnectionMethod "getDefault6" o = ActiveConnectionGetDefault6MethodInfo
ResolveActiveConnectionMethod "getDevices" o = ActiveConnectionGetDevicesMethodInfo
ResolveActiveConnectionMethod "getDhcp4Config" o = ActiveConnectionGetDhcp4ConfigMethodInfo
ResolveActiveConnectionMethod "getDhcp6Config" o = ActiveConnectionGetDhcp6ConfigMethodInfo
ResolveActiveConnectionMethod "getId" o = ActiveConnectionGetIdMethodInfo
ResolveActiveConnectionMethod "getIp4Config" o = ActiveConnectionGetIp4ConfigMethodInfo
ResolveActiveConnectionMethod "getIp6Config" o = ActiveConnectionGetIp6ConfigMethodInfo
ResolveActiveConnectionMethod "getMaster" o = ActiveConnectionGetMasterMethodInfo
ResolveActiveConnectionMethod "getPath" o = NM.Object.ObjectGetPathMethodInfo
ResolveActiveConnectionMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
ResolveActiveConnectionMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
ResolveActiveConnectionMethod "getSpecificObjectPath" o = ActiveConnectionGetSpecificObjectPathMethodInfo
ResolveActiveConnectionMethod "getState" o = ActiveConnectionGetStateMethodInfo
ResolveActiveConnectionMethod "getStateFlags" o = ActiveConnectionGetStateFlagsMethodInfo
ResolveActiveConnectionMethod "getStateReason" o = ActiveConnectionGetStateReasonMethodInfo
ResolveActiveConnectionMethod "getUuid" o = ActiveConnectionGetUuidMethodInfo
ResolveActiveConnectionMethod "getVpn" o = ActiveConnectionGetVpnMethodInfo
ResolveActiveConnectionMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
ResolveActiveConnectionMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
ResolveActiveConnectionMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
ResolveActiveConnectionMethod l o = O.MethodResolutionFailed l o
instance (info ~ ResolveActiveConnectionMethod t ActiveConnection, O.OverloadedMethod info ActiveConnection p) => OL.IsLabel t (ActiveConnection -> 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 ~ ResolveActiveConnectionMethod t ActiveConnection, O.OverloadedMethod info ActiveConnection p, R.HasField t ActiveConnection p) => R.HasField t ActiveConnection p where
getField = O.overloadedMethod @info
#endif
instance (info ~ ResolveActiveConnectionMethod t ActiveConnection, O.OverloadedMethodInfo info ActiveConnection) => OL.IsLabel t (O.MethodProxy info ActiveConnection) where
#if MIN_VERSION_base(4,10,0)
fromLabel = O.MethodProxy
#else
fromLabel _ = O.MethodProxy
#endif
#endif
type ActiveConnectionStateChangedCallback =
Word32
-> Word32
-> IO ()
type C_ActiveConnectionStateChangedCallback =
Ptr ActiveConnection ->
Word32 ->
Word32 ->
Ptr () ->
IO ()
foreign import ccall "wrapper"
mk_ActiveConnectionStateChangedCallback :: C_ActiveConnectionStateChangedCallback -> IO (FunPtr C_ActiveConnectionStateChangedCallback)
wrap_ActiveConnectionStateChangedCallback ::
GObject a => (a -> ActiveConnectionStateChangedCallback) ->
C_ActiveConnectionStateChangedCallback
wrap_ActiveConnectionStateChangedCallback :: forall a.
GObject a =>
(a -> ActiveConnectionStateChangedCallback)
-> C_ActiveConnectionStateChangedCallback
wrap_ActiveConnectionStateChangedCallback a -> ActiveConnectionStateChangedCallback
gi'cb Ptr ActiveConnection
gi'selfPtr Word32
state Word32
reason Ptr ()
_ = do
Ptr ActiveConnection -> (ActiveConnection -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr ActiveConnection
gi'selfPtr ((ActiveConnection -> IO ()) -> IO ())
-> (ActiveConnection -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ActiveConnection
gi'self -> a -> ActiveConnectionStateChangedCallback
gi'cb (ActiveConnection -> a
forall a b. Coercible a b => a -> b
Coerce.coerce ActiveConnection
gi'self) Word32
state Word32
reason
onActiveConnectionStateChanged :: (IsActiveConnection a, MonadIO m) => a -> ((?self :: a) => ActiveConnectionStateChangedCallback) -> m SignalHandlerId
onActiveConnectionStateChanged :: forall a (m :: * -> *).
(IsActiveConnection a, MonadIO m) =>
a
-> ((?self::a) => ActiveConnectionStateChangedCallback)
-> m SignalHandlerId
onActiveConnectionStateChanged a
obj (?self::a) => ActiveConnectionStateChangedCallback
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 -> ActiveConnectionStateChangedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ActiveConnectionStateChangedCallback
ActiveConnectionStateChangedCallback
cb
let wrapped' :: C_ActiveConnectionStateChangedCallback
wrapped' = (a -> ActiveConnectionStateChangedCallback)
-> C_ActiveConnectionStateChangedCallback
forall a.
GObject a =>
(a -> ActiveConnectionStateChangedCallback)
-> C_ActiveConnectionStateChangedCallback
wrap_ActiveConnectionStateChangedCallback a -> ActiveConnectionStateChangedCallback
wrapped
FunPtr C_ActiveConnectionStateChangedCallback
wrapped'' <- C_ActiveConnectionStateChangedCallback
-> IO (FunPtr C_ActiveConnectionStateChangedCallback)
mk_ActiveConnectionStateChangedCallback C_ActiveConnectionStateChangedCallback
wrapped'
a
-> Text
-> FunPtr C_ActiveConnectionStateChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"state-changed" FunPtr C_ActiveConnectionStateChangedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing
afterActiveConnectionStateChanged :: (IsActiveConnection a, MonadIO m) => a -> ((?self :: a) => ActiveConnectionStateChangedCallback) -> m SignalHandlerId
afterActiveConnectionStateChanged :: forall a (m :: * -> *).
(IsActiveConnection a, MonadIO m) =>
a
-> ((?self::a) => ActiveConnectionStateChangedCallback)
-> m SignalHandlerId
afterActiveConnectionStateChanged a
obj (?self::a) => ActiveConnectionStateChangedCallback
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 -> ActiveConnectionStateChangedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ActiveConnectionStateChangedCallback
ActiveConnectionStateChangedCallback
cb
let wrapped' :: C_ActiveConnectionStateChangedCallback
wrapped' = (a -> ActiveConnectionStateChangedCallback)
-> C_ActiveConnectionStateChangedCallback
forall a.
GObject a =>
(a -> ActiveConnectionStateChangedCallback)
-> C_ActiveConnectionStateChangedCallback
wrap_ActiveConnectionStateChangedCallback a -> ActiveConnectionStateChangedCallback
wrapped
FunPtr C_ActiveConnectionStateChangedCallback
wrapped'' <- C_ActiveConnectionStateChangedCallback
-> IO (FunPtr C_ActiveConnectionStateChangedCallback)
mk_ActiveConnectionStateChangedCallback C_ActiveConnectionStateChangedCallback
wrapped'
a
-> Text
-> FunPtr C_ActiveConnectionStateChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"state-changed" FunPtr C_ActiveConnectionStateChangedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing
#if defined(ENABLE_OVERLOADING)
data ActiveConnectionStateChangedSignalInfo
instance SignalInfo ActiveConnectionStateChangedSignalInfo where
type HaskellCallbackType ActiveConnectionStateChangedSignalInfo = ActiveConnectionStateChangedCallback
connectSignal obj cb connectMode detail = do
let cb' = wrap_ActiveConnectionStateChangedCallback cb
cb'' <- mk_ActiveConnectionStateChangedCallback cb'
connectSignalFunPtr obj "state-changed" cb'' connectMode detail
dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.ActiveConnection::state-changed"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-ActiveConnection.html#g:signal:stateChanged"})
#endif
getActiveConnectionConnection :: (MonadIO m, IsActiveConnection o) => o -> m NM.RemoteConnection.RemoteConnection
getActiveConnectionConnection :: forall (m :: * -> *) o.
(MonadIO m, IsActiveConnection o) =>
o -> m RemoteConnection
getActiveConnectionConnection o
obj = IO RemoteConnection -> m RemoteConnection
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO RemoteConnection -> m RemoteConnection)
-> IO RemoteConnection -> m RemoteConnection
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe RemoteConnection) -> IO RemoteConnection
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getActiveConnectionConnection" (IO (Maybe RemoteConnection) -> IO RemoteConnection)
-> IO (Maybe RemoteConnection) -> IO RemoteConnection
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr RemoteConnection -> RemoteConnection)
-> IO (Maybe RemoteConnection)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"connection" ManagedPtr RemoteConnection -> RemoteConnection
NM.RemoteConnection.RemoteConnection
#if defined(ENABLE_OVERLOADING)
data ActiveConnectionConnectionPropertyInfo
instance AttrInfo ActiveConnectionConnectionPropertyInfo where
type AttrAllowedOps ActiveConnectionConnectionPropertyInfo = '[ 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint ActiveConnectionConnectionPropertyInfo = IsActiveConnection
type AttrSetTypeConstraint ActiveConnectionConnectionPropertyInfo = (~) ()
type AttrTransferTypeConstraint ActiveConnectionConnectionPropertyInfo = (~) ()
type AttrTransferType ActiveConnectionConnectionPropertyInfo = ()
type AttrGetType ActiveConnectionConnectionPropertyInfo = NM.RemoteConnection.RemoteConnection
type AttrLabel ActiveConnectionConnectionPropertyInfo = "connection"
type AttrOrigin ActiveConnectionConnectionPropertyInfo = ActiveConnection
attrGet = getActiveConnectionConnection
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.ActiveConnection.connection"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-ActiveConnection.html#g:attr:connection"
})
#endif
getActiveConnectionController :: (MonadIO m, IsActiveConnection o) => o -> m (Maybe NM.Device.Device)
getActiveConnectionController :: forall (m :: * -> *) o.
(MonadIO m, IsActiveConnection o) =>
o -> m (Maybe Device)
getActiveConnectionController o
obj = IO (Maybe Device) -> m (Maybe Device)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Device) -> m (Maybe Device))
-> IO (Maybe Device) -> m (Maybe Device)
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr Device -> Device) -> IO (Maybe Device)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"controller" ManagedPtr Device -> Device
NM.Device.Device
#if defined(ENABLE_OVERLOADING)
data ActiveConnectionControllerPropertyInfo
instance AttrInfo ActiveConnectionControllerPropertyInfo where
type AttrAllowedOps ActiveConnectionControllerPropertyInfo = '[ 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint ActiveConnectionControllerPropertyInfo = IsActiveConnection
type AttrSetTypeConstraint ActiveConnectionControllerPropertyInfo = (~) ()
type AttrTransferTypeConstraint ActiveConnectionControllerPropertyInfo = (~) ()
type AttrTransferType ActiveConnectionControllerPropertyInfo = ()
type AttrGetType ActiveConnectionControllerPropertyInfo = (Maybe NM.Device.Device)
type AttrLabel ActiveConnectionControllerPropertyInfo = "controller"
type AttrOrigin ActiveConnectionControllerPropertyInfo = ActiveConnection
attrGet = getActiveConnectionController
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.ActiveConnection.controller"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-ActiveConnection.html#g:attr:controller"
})
#endif
getActiveConnectionDefault :: (MonadIO m, IsActiveConnection o) => o -> m Bool
getActiveConnectionDefault :: forall (m :: * -> *) o.
(MonadIO m, IsActiveConnection o) =>
o -> m Bool
getActiveConnectionDefault 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
"default"
#if defined(ENABLE_OVERLOADING)
data ActiveConnectionDefaultPropertyInfo
instance AttrInfo ActiveConnectionDefaultPropertyInfo where
type AttrAllowedOps ActiveConnectionDefaultPropertyInfo = '[ 'AttrGet]
type AttrBaseTypeConstraint ActiveConnectionDefaultPropertyInfo = IsActiveConnection
type AttrSetTypeConstraint ActiveConnectionDefaultPropertyInfo = (~) ()
type AttrTransferTypeConstraint ActiveConnectionDefaultPropertyInfo = (~) ()
type AttrTransferType ActiveConnectionDefaultPropertyInfo = ()
type AttrGetType ActiveConnectionDefaultPropertyInfo = Bool
type AttrLabel ActiveConnectionDefaultPropertyInfo = "default"
type AttrOrigin ActiveConnectionDefaultPropertyInfo = ActiveConnection
attrGet = getActiveConnectionDefault
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.ActiveConnection.default"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-ActiveConnection.html#g:attr:default"
})
#endif
getActiveConnectionDefault6 :: (MonadIO m, IsActiveConnection o) => o -> m Bool
getActiveConnectionDefault6 :: forall (m :: * -> *) o.
(MonadIO m, IsActiveConnection o) =>
o -> m Bool
getActiveConnectionDefault6 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
"default6"
#if defined(ENABLE_OVERLOADING)
data ActiveConnectionDefault6PropertyInfo
instance AttrInfo ActiveConnectionDefault6PropertyInfo where
type AttrAllowedOps ActiveConnectionDefault6PropertyInfo = '[ 'AttrGet]
type AttrBaseTypeConstraint ActiveConnectionDefault6PropertyInfo = IsActiveConnection
type AttrSetTypeConstraint ActiveConnectionDefault6PropertyInfo = (~) ()
type AttrTransferTypeConstraint ActiveConnectionDefault6PropertyInfo = (~) ()
type AttrTransferType ActiveConnectionDefault6PropertyInfo = ()
type AttrGetType ActiveConnectionDefault6PropertyInfo = Bool
type AttrLabel ActiveConnectionDefault6PropertyInfo = "default6"
type AttrOrigin ActiveConnectionDefault6PropertyInfo = ActiveConnection
attrGet = getActiveConnectionDefault6
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.ActiveConnection.default6"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-ActiveConnection.html#g:attr:default6"
})
#endif
#if defined(ENABLE_OVERLOADING)
data ActiveConnectionDevicesPropertyInfo
instance AttrInfo ActiveConnectionDevicesPropertyInfo where
type AttrAllowedOps ActiveConnectionDevicesPropertyInfo = '[]
type AttrSetTypeConstraint ActiveConnectionDevicesPropertyInfo = (~) ()
type AttrTransferTypeConstraint ActiveConnectionDevicesPropertyInfo = (~) ()
type AttrTransferType ActiveConnectionDevicesPropertyInfo = ()
type AttrBaseTypeConstraint ActiveConnectionDevicesPropertyInfo = (~) ()
type AttrGetType ActiveConnectionDevicesPropertyInfo = ()
type AttrLabel ActiveConnectionDevicesPropertyInfo = ""
type AttrOrigin ActiveConnectionDevicesPropertyInfo = ActiveConnection
attrGet = undefined
attrSet = undefined
attrConstruct = undefined
attrClear = undefined
attrTransfer = undefined
#endif
getActiveConnectionDhcp4Config :: (MonadIO m, IsActiveConnection o) => o -> m NM.DhcpConfig.DhcpConfig
getActiveConnectionDhcp4Config :: forall (m :: * -> *) o.
(MonadIO m, IsActiveConnection o) =>
o -> m DhcpConfig
getActiveConnectionDhcp4Config o
obj = IO DhcpConfig -> m DhcpConfig
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO DhcpConfig -> m DhcpConfig) -> IO DhcpConfig -> m DhcpConfig
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe DhcpConfig) -> IO DhcpConfig
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getActiveConnectionDhcp4Config" (IO (Maybe DhcpConfig) -> IO DhcpConfig)
-> IO (Maybe DhcpConfig) -> IO DhcpConfig
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr DhcpConfig -> DhcpConfig)
-> IO (Maybe DhcpConfig)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"dhcp4-config" ManagedPtr DhcpConfig -> DhcpConfig
NM.DhcpConfig.DhcpConfig
#if defined(ENABLE_OVERLOADING)
data ActiveConnectionDhcp4ConfigPropertyInfo
instance AttrInfo ActiveConnectionDhcp4ConfigPropertyInfo where
type AttrAllowedOps ActiveConnectionDhcp4ConfigPropertyInfo = '[ 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint ActiveConnectionDhcp4ConfigPropertyInfo = IsActiveConnection
type AttrSetTypeConstraint ActiveConnectionDhcp4ConfigPropertyInfo = (~) ()
type AttrTransferTypeConstraint ActiveConnectionDhcp4ConfigPropertyInfo = (~) ()
type AttrTransferType ActiveConnectionDhcp4ConfigPropertyInfo = ()
type AttrGetType ActiveConnectionDhcp4ConfigPropertyInfo = NM.DhcpConfig.DhcpConfig
type AttrLabel ActiveConnectionDhcp4ConfigPropertyInfo = "dhcp4-config"
type AttrOrigin ActiveConnectionDhcp4ConfigPropertyInfo = ActiveConnection
attrGet = getActiveConnectionDhcp4Config
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.ActiveConnection.dhcp4Config"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-ActiveConnection.html#g:attr:dhcp4Config"
})
#endif
getActiveConnectionDhcp6Config :: (MonadIO m, IsActiveConnection o) => o -> m NM.DhcpConfig.DhcpConfig
getActiveConnectionDhcp6Config :: forall (m :: * -> *) o.
(MonadIO m, IsActiveConnection o) =>
o -> m DhcpConfig
getActiveConnectionDhcp6Config o
obj = IO DhcpConfig -> m DhcpConfig
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO DhcpConfig -> m DhcpConfig) -> IO DhcpConfig -> m DhcpConfig
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe DhcpConfig) -> IO DhcpConfig
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getActiveConnectionDhcp6Config" (IO (Maybe DhcpConfig) -> IO DhcpConfig)
-> IO (Maybe DhcpConfig) -> IO DhcpConfig
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr DhcpConfig -> DhcpConfig)
-> IO (Maybe DhcpConfig)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"dhcp6-config" ManagedPtr DhcpConfig -> DhcpConfig
NM.DhcpConfig.DhcpConfig
#if defined(ENABLE_OVERLOADING)
data ActiveConnectionDhcp6ConfigPropertyInfo
instance AttrInfo ActiveConnectionDhcp6ConfigPropertyInfo where
type AttrAllowedOps ActiveConnectionDhcp6ConfigPropertyInfo = '[ 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint ActiveConnectionDhcp6ConfigPropertyInfo = IsActiveConnection
type AttrSetTypeConstraint ActiveConnectionDhcp6ConfigPropertyInfo = (~) ()
type AttrTransferTypeConstraint ActiveConnectionDhcp6ConfigPropertyInfo = (~) ()
type AttrTransferType ActiveConnectionDhcp6ConfigPropertyInfo = ()
type AttrGetType ActiveConnectionDhcp6ConfigPropertyInfo = NM.DhcpConfig.DhcpConfig
type AttrLabel ActiveConnectionDhcp6ConfigPropertyInfo = "dhcp6-config"
type AttrOrigin ActiveConnectionDhcp6ConfigPropertyInfo = ActiveConnection
attrGet = getActiveConnectionDhcp6Config
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.ActiveConnection.dhcp6Config"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-ActiveConnection.html#g:attr:dhcp6Config"
})
#endif
getActiveConnectionId :: (MonadIO m, IsActiveConnection o) => o -> m T.Text
getActiveConnectionId :: forall (m :: * -> *) o.
(MonadIO m, IsActiveConnection o) =>
o -> m Text
getActiveConnectionId 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
"getActiveConnectionId" (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
"id"
#if defined(ENABLE_OVERLOADING)
data ActiveConnectionIdPropertyInfo
instance AttrInfo ActiveConnectionIdPropertyInfo where
type AttrAllowedOps ActiveConnectionIdPropertyInfo = '[ 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint ActiveConnectionIdPropertyInfo = IsActiveConnection
type AttrSetTypeConstraint ActiveConnectionIdPropertyInfo = (~) ()
type AttrTransferTypeConstraint ActiveConnectionIdPropertyInfo = (~) ()
type AttrTransferType ActiveConnectionIdPropertyInfo = ()
type AttrGetType ActiveConnectionIdPropertyInfo = T.Text
type AttrLabel ActiveConnectionIdPropertyInfo = "id"
type AttrOrigin ActiveConnectionIdPropertyInfo = ActiveConnection
attrGet = getActiveConnectionId
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.ActiveConnection.id"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-ActiveConnection.html#g:attr:id"
})
#endif
getActiveConnectionIp4Config :: (MonadIO m, IsActiveConnection o) => o -> m NM.IPConfig.IPConfig
getActiveConnectionIp4Config :: forall (m :: * -> *) o.
(MonadIO m, IsActiveConnection o) =>
o -> m IPConfig
getActiveConnectionIp4Config o
obj = IO IPConfig -> m IPConfig
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO IPConfig -> m IPConfig) -> IO IPConfig -> m IPConfig
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe IPConfig) -> IO IPConfig
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getActiveConnectionIp4Config" (IO (Maybe IPConfig) -> IO IPConfig)
-> IO (Maybe IPConfig) -> IO IPConfig
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr IPConfig -> IPConfig)
-> IO (Maybe IPConfig)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"ip4-config" ManagedPtr IPConfig -> IPConfig
NM.IPConfig.IPConfig
#if defined(ENABLE_OVERLOADING)
data ActiveConnectionIp4ConfigPropertyInfo
instance AttrInfo ActiveConnectionIp4ConfigPropertyInfo where
type AttrAllowedOps ActiveConnectionIp4ConfigPropertyInfo = '[ 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint ActiveConnectionIp4ConfigPropertyInfo = IsActiveConnection
type AttrSetTypeConstraint ActiveConnectionIp4ConfigPropertyInfo = (~) ()
type AttrTransferTypeConstraint ActiveConnectionIp4ConfigPropertyInfo = (~) ()
type AttrTransferType ActiveConnectionIp4ConfigPropertyInfo = ()
type AttrGetType ActiveConnectionIp4ConfigPropertyInfo = NM.IPConfig.IPConfig
type AttrLabel ActiveConnectionIp4ConfigPropertyInfo = "ip4-config"
type AttrOrigin ActiveConnectionIp4ConfigPropertyInfo = ActiveConnection
attrGet = getActiveConnectionIp4Config
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.ActiveConnection.ip4Config"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-ActiveConnection.html#g:attr:ip4Config"
})
#endif
getActiveConnectionIp6Config :: (MonadIO m, IsActiveConnection o) => o -> m NM.IPConfig.IPConfig
getActiveConnectionIp6Config :: forall (m :: * -> *) o.
(MonadIO m, IsActiveConnection o) =>
o -> m IPConfig
getActiveConnectionIp6Config o
obj = IO IPConfig -> m IPConfig
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO IPConfig -> m IPConfig) -> IO IPConfig -> m IPConfig
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe IPConfig) -> IO IPConfig
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getActiveConnectionIp6Config" (IO (Maybe IPConfig) -> IO IPConfig)
-> IO (Maybe IPConfig) -> IO IPConfig
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr IPConfig -> IPConfig)
-> IO (Maybe IPConfig)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"ip6-config" ManagedPtr IPConfig -> IPConfig
NM.IPConfig.IPConfig
#if defined(ENABLE_OVERLOADING)
data ActiveConnectionIp6ConfigPropertyInfo
instance AttrInfo ActiveConnectionIp6ConfigPropertyInfo where
type AttrAllowedOps ActiveConnectionIp6ConfigPropertyInfo = '[ 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint ActiveConnectionIp6ConfigPropertyInfo = IsActiveConnection
type AttrSetTypeConstraint ActiveConnectionIp6ConfigPropertyInfo = (~) ()
type AttrTransferTypeConstraint ActiveConnectionIp6ConfigPropertyInfo = (~) ()
type AttrTransferType ActiveConnectionIp6ConfigPropertyInfo = ()
type AttrGetType ActiveConnectionIp6ConfigPropertyInfo = NM.IPConfig.IPConfig
type AttrLabel ActiveConnectionIp6ConfigPropertyInfo = "ip6-config"
type AttrOrigin ActiveConnectionIp6ConfigPropertyInfo = ActiveConnection
attrGet = getActiveConnectionIp6Config
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.ActiveConnection.ip6Config"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-ActiveConnection.html#g:attr:ip6Config"
})
#endif
getActiveConnectionMaster :: (MonadIO m, IsActiveConnection o) => o -> m (Maybe NM.Device.Device)
getActiveConnectionMaster :: forall (m :: * -> *) o.
(MonadIO m, IsActiveConnection o) =>
o -> m (Maybe Device)
getActiveConnectionMaster o
obj = IO (Maybe Device) -> m (Maybe Device)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Device) -> m (Maybe Device))
-> IO (Maybe Device) -> m (Maybe Device)
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr Device -> Device) -> IO (Maybe Device)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"master" ManagedPtr Device -> Device
NM.Device.Device
#if defined(ENABLE_OVERLOADING)
data ActiveConnectionMasterPropertyInfo
instance AttrInfo ActiveConnectionMasterPropertyInfo where
type AttrAllowedOps ActiveConnectionMasterPropertyInfo = '[ 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint ActiveConnectionMasterPropertyInfo = IsActiveConnection
type AttrSetTypeConstraint ActiveConnectionMasterPropertyInfo = (~) ()
type AttrTransferTypeConstraint ActiveConnectionMasterPropertyInfo = (~) ()
type AttrTransferType ActiveConnectionMasterPropertyInfo = ()
type AttrGetType ActiveConnectionMasterPropertyInfo = (Maybe NM.Device.Device)
type AttrLabel ActiveConnectionMasterPropertyInfo = "master"
type AttrOrigin ActiveConnectionMasterPropertyInfo = ActiveConnection
attrGet = getActiveConnectionMaster
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.ActiveConnection.master"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-ActiveConnection.html#g:attr:master"
})
#endif
getActiveConnectionSpecificObjectPath :: (MonadIO m, IsActiveConnection o) => o -> m T.Text
getActiveConnectionSpecificObjectPath :: forall (m :: * -> *) o.
(MonadIO m, IsActiveConnection o) =>
o -> m Text
getActiveConnectionSpecificObjectPath 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
"getActiveConnectionSpecificObjectPath" (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
"specific-object-path"
#if defined(ENABLE_OVERLOADING)
data ActiveConnectionSpecificObjectPathPropertyInfo
instance AttrInfo ActiveConnectionSpecificObjectPathPropertyInfo where
type AttrAllowedOps ActiveConnectionSpecificObjectPathPropertyInfo = '[ 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint ActiveConnectionSpecificObjectPathPropertyInfo = IsActiveConnection
type AttrSetTypeConstraint ActiveConnectionSpecificObjectPathPropertyInfo = (~) ()
type AttrTransferTypeConstraint ActiveConnectionSpecificObjectPathPropertyInfo = (~) ()
type AttrTransferType ActiveConnectionSpecificObjectPathPropertyInfo = ()
type AttrGetType ActiveConnectionSpecificObjectPathPropertyInfo = T.Text
type AttrLabel ActiveConnectionSpecificObjectPathPropertyInfo = "specific-object-path"
type AttrOrigin ActiveConnectionSpecificObjectPathPropertyInfo = ActiveConnection
attrGet = getActiveConnectionSpecificObjectPath
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.ActiveConnection.specificObjectPath"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-ActiveConnection.html#g:attr:specificObjectPath"
})
#endif
getActiveConnectionState :: (MonadIO m, IsActiveConnection o) => o -> m NM.Enums.ActiveConnectionState
getActiveConnectionState :: forall (m :: * -> *) o.
(MonadIO m, IsActiveConnection o) =>
o -> m ActiveConnectionState
getActiveConnectionState o
obj = IO ActiveConnectionState -> m ActiveConnectionState
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO ActiveConnectionState -> m ActiveConnectionState)
-> IO ActiveConnectionState -> m ActiveConnectionState
forall a b. (a -> b) -> a -> b
$ o -> String -> IO ActiveConnectionState
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 ActiveConnectionStatePropertyInfo
instance AttrInfo ActiveConnectionStatePropertyInfo where
type AttrAllowedOps ActiveConnectionStatePropertyInfo = '[ 'AttrGet]
type AttrBaseTypeConstraint ActiveConnectionStatePropertyInfo = IsActiveConnection
type AttrSetTypeConstraint ActiveConnectionStatePropertyInfo = (~) ()
type AttrTransferTypeConstraint ActiveConnectionStatePropertyInfo = (~) ()
type AttrTransferType ActiveConnectionStatePropertyInfo = ()
type AttrGetType ActiveConnectionStatePropertyInfo = NM.Enums.ActiveConnectionState
type AttrLabel ActiveConnectionStatePropertyInfo = "state"
type AttrOrigin ActiveConnectionStatePropertyInfo = ActiveConnection
attrGet = getActiveConnectionState
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.ActiveConnection.state"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-ActiveConnection.html#g:attr:state"
})
#endif
getActiveConnectionStateFlags :: (MonadIO m, IsActiveConnection o) => o -> m Word32
getActiveConnectionStateFlags :: forall (m :: * -> *) o.
(MonadIO m, IsActiveConnection o) =>
o -> m Word32
getActiveConnectionStateFlags 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
"state-flags"
#if defined(ENABLE_OVERLOADING)
data ActiveConnectionStateFlagsPropertyInfo
instance AttrInfo ActiveConnectionStateFlagsPropertyInfo where
type AttrAllowedOps ActiveConnectionStateFlagsPropertyInfo = '[ 'AttrGet]
type AttrBaseTypeConstraint ActiveConnectionStateFlagsPropertyInfo = IsActiveConnection
type AttrSetTypeConstraint ActiveConnectionStateFlagsPropertyInfo = (~) ()
type AttrTransferTypeConstraint ActiveConnectionStateFlagsPropertyInfo = (~) ()
type AttrTransferType ActiveConnectionStateFlagsPropertyInfo = ()
type AttrGetType ActiveConnectionStateFlagsPropertyInfo = Word32
type AttrLabel ActiveConnectionStateFlagsPropertyInfo = "state-flags"
type AttrOrigin ActiveConnectionStateFlagsPropertyInfo = ActiveConnection
attrGet = getActiveConnectionStateFlags
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.ActiveConnection.stateFlags"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-ActiveConnection.html#g:attr:stateFlags"
})
#endif
getActiveConnectionType :: (MonadIO m, IsActiveConnection o) => o -> m (Maybe T.Text)
getActiveConnectionType :: forall (m :: * -> *) o.
(MonadIO m, IsActiveConnection o) =>
o -> m (Maybe Text)
getActiveConnectionType 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
"type"
#if defined(ENABLE_OVERLOADING)
data ActiveConnectionTypePropertyInfo
instance AttrInfo ActiveConnectionTypePropertyInfo where
type AttrAllowedOps ActiveConnectionTypePropertyInfo = '[ 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint ActiveConnectionTypePropertyInfo = IsActiveConnection
type AttrSetTypeConstraint ActiveConnectionTypePropertyInfo = (~) ()
type AttrTransferTypeConstraint ActiveConnectionTypePropertyInfo = (~) ()
type AttrTransferType ActiveConnectionTypePropertyInfo = ()
type AttrGetType ActiveConnectionTypePropertyInfo = (Maybe T.Text)
type AttrLabel ActiveConnectionTypePropertyInfo = "type"
type AttrOrigin ActiveConnectionTypePropertyInfo = ActiveConnection
attrGet = getActiveConnectionType
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.ActiveConnection.type"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-ActiveConnection.html#g:attr:type"
})
#endif
getActiveConnectionUuid :: (MonadIO m, IsActiveConnection o) => o -> m T.Text
getActiveConnectionUuid :: forall (m :: * -> *) o.
(MonadIO m, IsActiveConnection o) =>
o -> m Text
getActiveConnectionUuid 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
"getActiveConnectionUuid" (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
"uuid"
#if defined(ENABLE_OVERLOADING)
data ActiveConnectionUuidPropertyInfo
instance AttrInfo ActiveConnectionUuidPropertyInfo where
type AttrAllowedOps ActiveConnectionUuidPropertyInfo = '[ 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint ActiveConnectionUuidPropertyInfo = IsActiveConnection
type AttrSetTypeConstraint ActiveConnectionUuidPropertyInfo = (~) ()
type AttrTransferTypeConstraint ActiveConnectionUuidPropertyInfo = (~) ()
type AttrTransferType ActiveConnectionUuidPropertyInfo = ()
type AttrGetType ActiveConnectionUuidPropertyInfo = T.Text
type AttrLabel ActiveConnectionUuidPropertyInfo = "uuid"
type AttrOrigin ActiveConnectionUuidPropertyInfo = ActiveConnection
attrGet = getActiveConnectionUuid
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.ActiveConnection.uuid"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-ActiveConnection.html#g:attr:uuid"
})
#endif
getActiveConnectionVpn :: (MonadIO m, IsActiveConnection o) => o -> m Bool
getActiveConnectionVpn :: forall (m :: * -> *) o.
(MonadIO m, IsActiveConnection o) =>
o -> m Bool
getActiveConnectionVpn 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
"vpn"
#if defined(ENABLE_OVERLOADING)
data ActiveConnectionVpnPropertyInfo
instance AttrInfo ActiveConnectionVpnPropertyInfo where
type AttrAllowedOps ActiveConnectionVpnPropertyInfo = '[ 'AttrGet]
type AttrBaseTypeConstraint ActiveConnectionVpnPropertyInfo = IsActiveConnection
type AttrSetTypeConstraint ActiveConnectionVpnPropertyInfo = (~) ()
type AttrTransferTypeConstraint ActiveConnectionVpnPropertyInfo = (~) ()
type AttrTransferType ActiveConnectionVpnPropertyInfo = ()
type AttrGetType ActiveConnectionVpnPropertyInfo = Bool
type AttrLabel ActiveConnectionVpnPropertyInfo = "vpn"
type AttrOrigin ActiveConnectionVpnPropertyInfo = ActiveConnection
attrGet = getActiveConnectionVpn
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.ActiveConnection.vpn"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-ActiveConnection.html#g:attr:vpn"
})
#endif
#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ActiveConnection
type instance O.AttributeList ActiveConnection = ActiveConnectionAttributeList
type ActiveConnectionAttributeList = ('[ '("client", NM.Object.ObjectClientPropertyInfo), '("connection", ActiveConnectionConnectionPropertyInfo), '("controller", ActiveConnectionControllerPropertyInfo), '("default", ActiveConnectionDefaultPropertyInfo), '("default6", ActiveConnectionDefault6PropertyInfo), '("devices", ActiveConnectionDevicesPropertyInfo), '("dhcp4Config", ActiveConnectionDhcp4ConfigPropertyInfo), '("dhcp6Config", ActiveConnectionDhcp6ConfigPropertyInfo), '("id", ActiveConnectionIdPropertyInfo), '("ip4Config", ActiveConnectionIp4ConfigPropertyInfo), '("ip6Config", ActiveConnectionIp6ConfigPropertyInfo), '("master", ActiveConnectionMasterPropertyInfo), '("path", NM.Object.ObjectPathPropertyInfo), '("specificObjectPath", ActiveConnectionSpecificObjectPathPropertyInfo), '("state", ActiveConnectionStatePropertyInfo), '("stateFlags", ActiveConnectionStateFlagsPropertyInfo), '("type", ActiveConnectionTypePropertyInfo), '("uuid", ActiveConnectionUuidPropertyInfo), '("vpn", ActiveConnectionVpnPropertyInfo)] :: [(Symbol, DK.Type)])
#endif
#if defined(ENABLE_OVERLOADING)
activeConnectionConnection :: AttrLabelProxy "connection"
activeConnectionConnection = AttrLabelProxy
activeConnectionController :: AttrLabelProxy "controller"
activeConnectionController = AttrLabelProxy
activeConnectionDefault :: AttrLabelProxy "default"
activeConnectionDefault = AttrLabelProxy
activeConnectionDefault6 :: AttrLabelProxy "default6"
activeConnectionDefault6 = AttrLabelProxy
activeConnectionDevices :: AttrLabelProxy "devices"
activeConnectionDevices = AttrLabelProxy
activeConnectionDhcp4Config :: AttrLabelProxy "dhcp4Config"
activeConnectionDhcp4Config = AttrLabelProxy
activeConnectionDhcp6Config :: AttrLabelProxy "dhcp6Config"
activeConnectionDhcp6Config = AttrLabelProxy
activeConnectionId :: AttrLabelProxy "id"
activeConnectionId = AttrLabelProxy
activeConnectionIp4Config :: AttrLabelProxy "ip4Config"
activeConnectionIp4Config = AttrLabelProxy
activeConnectionIp6Config :: AttrLabelProxy "ip6Config"
activeConnectionIp6Config = AttrLabelProxy
activeConnectionMaster :: AttrLabelProxy "master"
activeConnectionMaster = AttrLabelProxy
activeConnectionSpecificObjectPath :: AttrLabelProxy "specificObjectPath"
activeConnectionSpecificObjectPath = AttrLabelProxy
activeConnectionState :: AttrLabelProxy "state"
activeConnectionState = AttrLabelProxy
activeConnectionStateFlags :: AttrLabelProxy "stateFlags"
activeConnectionStateFlags = AttrLabelProxy
activeConnectionType :: AttrLabelProxy "type"
activeConnectionType = AttrLabelProxy
activeConnectionUuid :: AttrLabelProxy "uuid"
activeConnectionUuid = AttrLabelProxy
activeConnectionVpn :: AttrLabelProxy "vpn"
activeConnectionVpn = AttrLabelProxy
#endif
#if defined(ENABLE_OVERLOADING)
type instance O.SignalList ActiveConnection = ActiveConnectionSignalList
type ActiveConnectionSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo), '("stateChanged", ActiveConnectionStateChangedSignalInfo)] :: [(Symbol, DK.Type)])
#endif
foreign import ccall "nm_active_connection_get_connection" nm_active_connection_get_connection ::
Ptr ActiveConnection ->
IO (Ptr NM.RemoteConnection.RemoteConnection)
activeConnectionGetConnection ::
(B.CallStack.HasCallStack, MonadIO m, IsActiveConnection a) =>
a
-> m NM.RemoteConnection.RemoteConnection
activeConnectionGetConnection :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsActiveConnection a) =>
a -> m RemoteConnection
activeConnectionGetConnection a
connection = 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 ActiveConnection
connection' <- a -> IO (Ptr ActiveConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
Ptr RemoteConnection
result <- Ptr ActiveConnection -> IO (Ptr RemoteConnection)
nm_active_connection_get_connection Ptr ActiveConnection
connection'
Text -> Ptr RemoteConnection -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"activeConnectionGetConnection" 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
connection
RemoteConnection -> IO RemoteConnection
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return RemoteConnection
result'
#if defined(ENABLE_OVERLOADING)
data ActiveConnectionGetConnectionMethodInfo
instance (signature ~ (m NM.RemoteConnection.RemoteConnection), MonadIO m, IsActiveConnection a) => O.OverloadedMethod ActiveConnectionGetConnectionMethodInfo a signature where
overloadedMethod = activeConnectionGetConnection
instance O.OverloadedMethodInfo ActiveConnectionGetConnectionMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.ActiveConnection.activeConnectionGetConnection",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-ActiveConnection.html#v:activeConnectionGetConnection"
})
#endif
foreign import ccall "nm_active_connection_get_connection_type" nm_active_connection_get_connection_type ::
Ptr ActiveConnection ->
IO CString
activeConnectionGetConnectionType ::
(B.CallStack.HasCallStack, MonadIO m, IsActiveConnection a) =>
a
-> m T.Text
activeConnectionGetConnectionType :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsActiveConnection a) =>
a -> m Text
activeConnectionGetConnectionType a
connection = 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 ActiveConnection
connection' <- a -> IO (Ptr ActiveConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
CString
result <- Ptr ActiveConnection -> IO CString
nm_active_connection_get_connection_type Ptr ActiveConnection
connection'
Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"activeConnectionGetConnectionType" CString
result
Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
connection
Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'
#if defined(ENABLE_OVERLOADING)
data ActiveConnectionGetConnectionTypeMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsActiveConnection a) => O.OverloadedMethod ActiveConnectionGetConnectionTypeMethodInfo a signature where
overloadedMethod = activeConnectionGetConnectionType
instance O.OverloadedMethodInfo ActiveConnectionGetConnectionTypeMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.ActiveConnection.activeConnectionGetConnectionType",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-ActiveConnection.html#v:activeConnectionGetConnectionType"
})
#endif
foreign import ccall "nm_active_connection_get_controller" nm_active_connection_get_controller ::
Ptr ActiveConnection ->
IO (Ptr ())
activeConnectionGetController ::
(B.CallStack.HasCallStack, MonadIO m, IsActiveConnection a) =>
a
-> m (Ptr ())
activeConnectionGetController :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsActiveConnection a) =>
a -> m (Ptr ())
activeConnectionGetController a
connection = IO (Ptr ()) -> m (Ptr ())
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr ()) -> m (Ptr ())) -> IO (Ptr ()) -> m (Ptr ())
forall a b. (a -> b) -> a -> b
$ do
Ptr ActiveConnection
connection' <- a -> IO (Ptr ActiveConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
Ptr ()
result <- Ptr ActiveConnection -> IO (Ptr ())
nm_active_connection_get_controller Ptr ActiveConnection
connection'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
connection
Ptr () -> IO (Ptr ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ()
result
#if defined(ENABLE_OVERLOADING)
data ActiveConnectionGetControllerMethodInfo
instance (signature ~ (m (Ptr ())), MonadIO m, IsActiveConnection a) => O.OverloadedMethod ActiveConnectionGetControllerMethodInfo a signature where
overloadedMethod = activeConnectionGetController
instance O.OverloadedMethodInfo ActiveConnectionGetControllerMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.ActiveConnection.activeConnectionGetController",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-ActiveConnection.html#v:activeConnectionGetController"
})
#endif
foreign import ccall "nm_active_connection_get_default" nm_active_connection_get_default ::
Ptr ActiveConnection ->
IO CInt
activeConnectionGetDefault ::
(B.CallStack.HasCallStack, MonadIO m, IsActiveConnection a) =>
a
-> m Bool
activeConnectionGetDefault :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsActiveConnection a) =>
a -> m Bool
activeConnectionGetDefault a
connection = 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 ActiveConnection
connection' <- a -> IO (Ptr ActiveConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
CInt
result <- Ptr ActiveConnection -> IO CInt
nm_active_connection_get_default Ptr ActiveConnection
connection'
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
connection
Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data ActiveConnectionGetDefaultMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsActiveConnection a) => O.OverloadedMethod ActiveConnectionGetDefaultMethodInfo a signature where
overloadedMethod = activeConnectionGetDefault
instance O.OverloadedMethodInfo ActiveConnectionGetDefaultMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.ActiveConnection.activeConnectionGetDefault",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-ActiveConnection.html#v:activeConnectionGetDefault"
})
#endif
foreign import ccall "nm_active_connection_get_default6" nm_active_connection_get_default6 ::
Ptr ActiveConnection ->
IO CInt
activeConnectionGetDefault6 ::
(B.CallStack.HasCallStack, MonadIO m, IsActiveConnection a) =>
a
-> m Bool
activeConnectionGetDefault6 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsActiveConnection a) =>
a -> m Bool
activeConnectionGetDefault6 a
connection = 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 ActiveConnection
connection' <- a -> IO (Ptr ActiveConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
CInt
result <- Ptr ActiveConnection -> IO CInt
nm_active_connection_get_default6 Ptr ActiveConnection
connection'
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
connection
Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data ActiveConnectionGetDefault6MethodInfo
instance (signature ~ (m Bool), MonadIO m, IsActiveConnection a) => O.OverloadedMethod ActiveConnectionGetDefault6MethodInfo a signature where
overloadedMethod = activeConnectionGetDefault6
instance O.OverloadedMethodInfo ActiveConnectionGetDefault6MethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.ActiveConnection.activeConnectionGetDefault6",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-ActiveConnection.html#v:activeConnectionGetDefault6"
})
#endif
foreign import ccall "nm_active_connection_get_devices" nm_active_connection_get_devices ::
Ptr ActiveConnection ->
IO (Ptr (GPtrArray (Ptr NM.Device.Device)))
activeConnectionGetDevices ::
(B.CallStack.HasCallStack, MonadIO m, IsActiveConnection a) =>
a
-> m [NM.Device.Device]
activeConnectionGetDevices :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsActiveConnection a) =>
a -> m [Device]
activeConnectionGetDevices a
connection = 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 ActiveConnection
connection' <- a -> IO (Ptr ActiveConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
Ptr (GPtrArray (Ptr Device))
result <- Ptr ActiveConnection -> IO (Ptr (GPtrArray (Ptr Device)))
nm_active_connection_get_devices Ptr ActiveConnection
connection'
Text -> Ptr (GPtrArray (Ptr Device)) -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"activeConnectionGetDevices" 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
connection
[Device] -> IO [Device]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Device]
result''
#if defined(ENABLE_OVERLOADING)
data ActiveConnectionGetDevicesMethodInfo
instance (signature ~ (m [NM.Device.Device]), MonadIO m, IsActiveConnection a) => O.OverloadedMethod ActiveConnectionGetDevicesMethodInfo a signature where
overloadedMethod = activeConnectionGetDevices
instance O.OverloadedMethodInfo ActiveConnectionGetDevicesMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.ActiveConnection.activeConnectionGetDevices",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-ActiveConnection.html#v:activeConnectionGetDevices"
})
#endif
foreign import ccall "nm_active_connection_get_dhcp4_config" nm_active_connection_get_dhcp4_config ::
Ptr ActiveConnection ->
IO (Ptr NM.DhcpConfig.DhcpConfig)
activeConnectionGetDhcp4Config ::
(B.CallStack.HasCallStack, MonadIO m, IsActiveConnection a) =>
a
-> m NM.DhcpConfig.DhcpConfig
activeConnectionGetDhcp4Config :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsActiveConnection a) =>
a -> m DhcpConfig
activeConnectionGetDhcp4Config a
connection = IO DhcpConfig -> m DhcpConfig
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DhcpConfig -> m DhcpConfig) -> IO DhcpConfig -> m DhcpConfig
forall a b. (a -> b) -> a -> b
$ do
Ptr ActiveConnection
connection' <- a -> IO (Ptr ActiveConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
Ptr DhcpConfig
result <- Ptr ActiveConnection -> IO (Ptr DhcpConfig)
nm_active_connection_get_dhcp4_config Ptr ActiveConnection
connection'
Text -> Ptr DhcpConfig -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"activeConnectionGetDhcp4Config" Ptr DhcpConfig
result
DhcpConfig
result' <- ((ManagedPtr DhcpConfig -> DhcpConfig)
-> Ptr DhcpConfig -> IO DhcpConfig
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr DhcpConfig -> DhcpConfig
NM.DhcpConfig.DhcpConfig) Ptr DhcpConfig
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
connection
DhcpConfig -> IO DhcpConfig
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return DhcpConfig
result'
#if defined(ENABLE_OVERLOADING)
data ActiveConnectionGetDhcp4ConfigMethodInfo
instance (signature ~ (m NM.DhcpConfig.DhcpConfig), MonadIO m, IsActiveConnection a) => O.OverloadedMethod ActiveConnectionGetDhcp4ConfigMethodInfo a signature where
overloadedMethod = activeConnectionGetDhcp4Config
instance O.OverloadedMethodInfo ActiveConnectionGetDhcp4ConfigMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.ActiveConnection.activeConnectionGetDhcp4Config",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-ActiveConnection.html#v:activeConnectionGetDhcp4Config"
})
#endif
foreign import ccall "nm_active_connection_get_dhcp6_config" nm_active_connection_get_dhcp6_config ::
Ptr ActiveConnection ->
IO (Ptr NM.DhcpConfig.DhcpConfig)
activeConnectionGetDhcp6Config ::
(B.CallStack.HasCallStack, MonadIO m, IsActiveConnection a) =>
a
-> m NM.DhcpConfig.DhcpConfig
activeConnectionGetDhcp6Config :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsActiveConnection a) =>
a -> m DhcpConfig
activeConnectionGetDhcp6Config a
connection = IO DhcpConfig -> m DhcpConfig
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DhcpConfig -> m DhcpConfig) -> IO DhcpConfig -> m DhcpConfig
forall a b. (a -> b) -> a -> b
$ do
Ptr ActiveConnection
connection' <- a -> IO (Ptr ActiveConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
Ptr DhcpConfig
result <- Ptr ActiveConnection -> IO (Ptr DhcpConfig)
nm_active_connection_get_dhcp6_config Ptr ActiveConnection
connection'
Text -> Ptr DhcpConfig -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"activeConnectionGetDhcp6Config" Ptr DhcpConfig
result
DhcpConfig
result' <- ((ManagedPtr DhcpConfig -> DhcpConfig)
-> Ptr DhcpConfig -> IO DhcpConfig
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr DhcpConfig -> DhcpConfig
NM.DhcpConfig.DhcpConfig) Ptr DhcpConfig
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
connection
DhcpConfig -> IO DhcpConfig
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return DhcpConfig
result'
#if defined(ENABLE_OVERLOADING)
data ActiveConnectionGetDhcp6ConfigMethodInfo
instance (signature ~ (m NM.DhcpConfig.DhcpConfig), MonadIO m, IsActiveConnection a) => O.OverloadedMethod ActiveConnectionGetDhcp6ConfigMethodInfo a signature where
overloadedMethod = activeConnectionGetDhcp6Config
instance O.OverloadedMethodInfo ActiveConnectionGetDhcp6ConfigMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.ActiveConnection.activeConnectionGetDhcp6Config",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-ActiveConnection.html#v:activeConnectionGetDhcp6Config"
})
#endif
foreign import ccall "nm_active_connection_get_id" nm_active_connection_get_id ::
Ptr ActiveConnection ->
IO CString
activeConnectionGetId ::
(B.CallStack.HasCallStack, MonadIO m, IsActiveConnection a) =>
a
-> m T.Text
activeConnectionGetId :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsActiveConnection a) =>
a -> m Text
activeConnectionGetId a
connection = 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 ActiveConnection
connection' <- a -> IO (Ptr ActiveConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
CString
result <- Ptr ActiveConnection -> IO CString
nm_active_connection_get_id Ptr ActiveConnection
connection'
Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"activeConnectionGetId" CString
result
Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
connection
Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'
#if defined(ENABLE_OVERLOADING)
data ActiveConnectionGetIdMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsActiveConnection a) => O.OverloadedMethod ActiveConnectionGetIdMethodInfo a signature where
overloadedMethod = activeConnectionGetId
instance O.OverloadedMethodInfo ActiveConnectionGetIdMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.ActiveConnection.activeConnectionGetId",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-ActiveConnection.html#v:activeConnectionGetId"
})
#endif
foreign import ccall "nm_active_connection_get_ip4_config" nm_active_connection_get_ip4_config ::
Ptr ActiveConnection ->
IO (Ptr NM.IPConfig.IPConfig)
activeConnectionGetIp4Config ::
(B.CallStack.HasCallStack, MonadIO m, IsActiveConnection a) =>
a
-> m NM.IPConfig.IPConfig
activeConnectionGetIp4Config :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsActiveConnection a) =>
a -> m IPConfig
activeConnectionGetIp4Config a
connection = IO IPConfig -> m IPConfig
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IPConfig -> m IPConfig) -> IO IPConfig -> m IPConfig
forall a b. (a -> b) -> a -> b
$ do
Ptr ActiveConnection
connection' <- a -> IO (Ptr ActiveConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
Ptr IPConfig
result <- Ptr ActiveConnection -> IO (Ptr IPConfig)
nm_active_connection_get_ip4_config Ptr ActiveConnection
connection'
Text -> Ptr IPConfig -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"activeConnectionGetIp4Config" Ptr IPConfig
result
IPConfig
result' <- ((ManagedPtr IPConfig -> IPConfig) -> Ptr IPConfig -> IO IPConfig
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr IPConfig -> IPConfig
NM.IPConfig.IPConfig) Ptr IPConfig
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
connection
IPConfig -> IO IPConfig
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IPConfig
result'
#if defined(ENABLE_OVERLOADING)
data ActiveConnectionGetIp4ConfigMethodInfo
instance (signature ~ (m NM.IPConfig.IPConfig), MonadIO m, IsActiveConnection a) => O.OverloadedMethod ActiveConnectionGetIp4ConfigMethodInfo a signature where
overloadedMethod = activeConnectionGetIp4Config
instance O.OverloadedMethodInfo ActiveConnectionGetIp4ConfigMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.ActiveConnection.activeConnectionGetIp4Config",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-ActiveConnection.html#v:activeConnectionGetIp4Config"
})
#endif
foreign import ccall "nm_active_connection_get_ip6_config" nm_active_connection_get_ip6_config ::
Ptr ActiveConnection ->
IO (Ptr NM.IPConfig.IPConfig)
activeConnectionGetIp6Config ::
(B.CallStack.HasCallStack, MonadIO m, IsActiveConnection a) =>
a
-> m NM.IPConfig.IPConfig
activeConnectionGetIp6Config :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsActiveConnection a) =>
a -> m IPConfig
activeConnectionGetIp6Config a
connection = IO IPConfig -> m IPConfig
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IPConfig -> m IPConfig) -> IO IPConfig -> m IPConfig
forall a b. (a -> b) -> a -> b
$ do
Ptr ActiveConnection
connection' <- a -> IO (Ptr ActiveConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
Ptr IPConfig
result <- Ptr ActiveConnection -> IO (Ptr IPConfig)
nm_active_connection_get_ip6_config Ptr ActiveConnection
connection'
Text -> Ptr IPConfig -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"activeConnectionGetIp6Config" Ptr IPConfig
result
IPConfig
result' <- ((ManagedPtr IPConfig -> IPConfig) -> Ptr IPConfig -> IO IPConfig
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr IPConfig -> IPConfig
NM.IPConfig.IPConfig) Ptr IPConfig
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
connection
IPConfig -> IO IPConfig
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IPConfig
result'
#if defined(ENABLE_OVERLOADING)
data ActiveConnectionGetIp6ConfigMethodInfo
instance (signature ~ (m NM.IPConfig.IPConfig), MonadIO m, IsActiveConnection a) => O.OverloadedMethod ActiveConnectionGetIp6ConfigMethodInfo a signature where
overloadedMethod = activeConnectionGetIp6Config
instance O.OverloadedMethodInfo ActiveConnectionGetIp6ConfigMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.ActiveConnection.activeConnectionGetIp6Config",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-ActiveConnection.html#v:activeConnectionGetIp6Config"
})
#endif
foreign import ccall "nm_active_connection_get_master" nm_active_connection_get_master ::
Ptr ActiveConnection ->
IO (Ptr ())
{-# DEPRECATED activeConnectionGetMaster ["(Since version 1.44)","Use 'GI.NM.Objects.ActiveConnection.activeConnectionGetController' instead."] #-}
activeConnectionGetMaster ::
(B.CallStack.HasCallStack, MonadIO m, IsActiveConnection a) =>
a
-> m (Ptr ())
activeConnectionGetMaster :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsActiveConnection a) =>
a -> m (Ptr ())
activeConnectionGetMaster a
connection = IO (Ptr ()) -> m (Ptr ())
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr ()) -> m (Ptr ())) -> IO (Ptr ()) -> m (Ptr ())
forall a b. (a -> b) -> a -> b
$ do
Ptr ActiveConnection
connection' <- a -> IO (Ptr ActiveConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
Ptr ()
result <- Ptr ActiveConnection -> IO (Ptr ())
nm_active_connection_get_master Ptr ActiveConnection
connection'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
connection
Ptr () -> IO (Ptr ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ()
result
#if defined(ENABLE_OVERLOADING)
data ActiveConnectionGetMasterMethodInfo
instance (signature ~ (m (Ptr ())), MonadIO m, IsActiveConnection a) => O.OverloadedMethod ActiveConnectionGetMasterMethodInfo a signature where
overloadedMethod = activeConnectionGetMaster
instance O.OverloadedMethodInfo ActiveConnectionGetMasterMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.ActiveConnection.activeConnectionGetMaster",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-ActiveConnection.html#v:activeConnectionGetMaster"
})
#endif
foreign import ccall "nm_active_connection_get_specific_object_path" nm_active_connection_get_specific_object_path ::
Ptr ActiveConnection ->
IO CString
activeConnectionGetSpecificObjectPath ::
(B.CallStack.HasCallStack, MonadIO m, IsActiveConnection a) =>
a
-> m T.Text
activeConnectionGetSpecificObjectPath :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsActiveConnection a) =>
a -> m Text
activeConnectionGetSpecificObjectPath a
connection = 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 ActiveConnection
connection' <- a -> IO (Ptr ActiveConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
CString
result <- Ptr ActiveConnection -> IO CString
nm_active_connection_get_specific_object_path Ptr ActiveConnection
connection'
Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"activeConnectionGetSpecificObjectPath" CString
result
Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
connection
Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'
#if defined(ENABLE_OVERLOADING)
data ActiveConnectionGetSpecificObjectPathMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsActiveConnection a) => O.OverloadedMethod ActiveConnectionGetSpecificObjectPathMethodInfo a signature where
overloadedMethod = activeConnectionGetSpecificObjectPath
instance O.OverloadedMethodInfo ActiveConnectionGetSpecificObjectPathMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.ActiveConnection.activeConnectionGetSpecificObjectPath",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-ActiveConnection.html#v:activeConnectionGetSpecificObjectPath"
})
#endif
foreign import ccall "nm_active_connection_get_state" nm_active_connection_get_state ::
Ptr ActiveConnection ->
IO CUInt
activeConnectionGetState ::
(B.CallStack.HasCallStack, MonadIO m, IsActiveConnection a) =>
a
-> m NM.Enums.ActiveConnectionState
activeConnectionGetState :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsActiveConnection a) =>
a -> m ActiveConnectionState
activeConnectionGetState a
connection = IO ActiveConnectionState -> m ActiveConnectionState
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ActiveConnectionState -> m ActiveConnectionState)
-> IO ActiveConnectionState -> m ActiveConnectionState
forall a b. (a -> b) -> a -> b
$ do
Ptr ActiveConnection
connection' <- a -> IO (Ptr ActiveConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
CUInt
result <- Ptr ActiveConnection -> IO CUInt
nm_active_connection_get_state Ptr ActiveConnection
connection'
let result' :: ActiveConnectionState
result' = (Int -> ActiveConnectionState
forall a. Enum a => Int -> a
toEnum (Int -> ActiveConnectionState)
-> (CUInt -> Int) -> CUInt -> ActiveConnectionState
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
connection
ActiveConnectionState -> IO ActiveConnectionState
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ActiveConnectionState
result'
#if defined(ENABLE_OVERLOADING)
data ActiveConnectionGetStateMethodInfo
instance (signature ~ (m NM.Enums.ActiveConnectionState), MonadIO m, IsActiveConnection a) => O.OverloadedMethod ActiveConnectionGetStateMethodInfo a signature where
overloadedMethod = activeConnectionGetState
instance O.OverloadedMethodInfo ActiveConnectionGetStateMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.ActiveConnection.activeConnectionGetState",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-ActiveConnection.html#v:activeConnectionGetState"
})
#endif
foreign import ccall "nm_active_connection_get_state_flags" nm_active_connection_get_state_flags ::
Ptr ActiveConnection ->
IO CUInt
activeConnectionGetStateFlags ::
(B.CallStack.HasCallStack, MonadIO m, IsActiveConnection a) =>
a
-> m [NM.Flags.ActivationStateFlags]
activeConnectionGetStateFlags :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsActiveConnection a) =>
a -> m [ActivationStateFlags]
activeConnectionGetStateFlags a
connection = IO [ActivationStateFlags] -> m [ActivationStateFlags]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ActivationStateFlags] -> m [ActivationStateFlags])
-> IO [ActivationStateFlags] -> m [ActivationStateFlags]
forall a b. (a -> b) -> a -> b
$ do
Ptr ActiveConnection
connection' <- a -> IO (Ptr ActiveConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
CUInt
result <- Ptr ActiveConnection -> IO CUInt
nm_active_connection_get_state_flags Ptr ActiveConnection
connection'
let result' :: [ActivationStateFlags]
result' = CUInt -> [ActivationStateFlags]
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
connection
[ActivationStateFlags] -> IO [ActivationStateFlags]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [ActivationStateFlags]
result'
#if defined(ENABLE_OVERLOADING)
data ActiveConnectionGetStateFlagsMethodInfo
instance (signature ~ (m [NM.Flags.ActivationStateFlags]), MonadIO m, IsActiveConnection a) => O.OverloadedMethod ActiveConnectionGetStateFlagsMethodInfo a signature where
overloadedMethod = activeConnectionGetStateFlags
instance O.OverloadedMethodInfo ActiveConnectionGetStateFlagsMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.ActiveConnection.activeConnectionGetStateFlags",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-ActiveConnection.html#v:activeConnectionGetStateFlags"
})
#endif
foreign import ccall "nm_active_connection_get_state_reason" nm_active_connection_get_state_reason ::
Ptr ActiveConnection ->
IO CUInt
activeConnectionGetStateReason ::
(B.CallStack.HasCallStack, MonadIO m, IsActiveConnection a) =>
a
-> m NM.Enums.ActiveConnectionStateReason
activeConnectionGetStateReason :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsActiveConnection a) =>
a -> m ActiveConnectionStateReason
activeConnectionGetStateReason a
connection = IO ActiveConnectionStateReason -> m ActiveConnectionStateReason
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ActiveConnectionStateReason -> m ActiveConnectionStateReason)
-> IO ActiveConnectionStateReason -> m ActiveConnectionStateReason
forall a b. (a -> b) -> a -> b
$ do
Ptr ActiveConnection
connection' <- a -> IO (Ptr ActiveConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
CUInt
result <- Ptr ActiveConnection -> IO CUInt
nm_active_connection_get_state_reason Ptr ActiveConnection
connection'
let result' :: ActiveConnectionStateReason
result' = (Int -> ActiveConnectionStateReason
forall a. Enum a => Int -> a
toEnum (Int -> ActiveConnectionStateReason)
-> (CUInt -> Int) -> CUInt -> ActiveConnectionStateReason
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
connection
ActiveConnectionStateReason -> IO ActiveConnectionStateReason
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ActiveConnectionStateReason
result'
#if defined(ENABLE_OVERLOADING)
data ActiveConnectionGetStateReasonMethodInfo
instance (signature ~ (m NM.Enums.ActiveConnectionStateReason), MonadIO m, IsActiveConnection a) => O.OverloadedMethod ActiveConnectionGetStateReasonMethodInfo a signature where
overloadedMethod = activeConnectionGetStateReason
instance O.OverloadedMethodInfo ActiveConnectionGetStateReasonMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.ActiveConnection.activeConnectionGetStateReason",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-ActiveConnection.html#v:activeConnectionGetStateReason"
})
#endif
foreign import ccall "nm_active_connection_get_uuid" nm_active_connection_get_uuid ::
Ptr ActiveConnection ->
IO CString
activeConnectionGetUuid ::
(B.CallStack.HasCallStack, MonadIO m, IsActiveConnection a) =>
a
-> m T.Text
activeConnectionGetUuid :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsActiveConnection a) =>
a -> m Text
activeConnectionGetUuid a
connection = 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 ActiveConnection
connection' <- a -> IO (Ptr ActiveConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
CString
result <- Ptr ActiveConnection -> IO CString
nm_active_connection_get_uuid Ptr ActiveConnection
connection'
Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"activeConnectionGetUuid" CString
result
Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
connection
Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'
#if defined(ENABLE_OVERLOADING)
data ActiveConnectionGetUuidMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsActiveConnection a) => O.OverloadedMethod ActiveConnectionGetUuidMethodInfo a signature where
overloadedMethod = activeConnectionGetUuid
instance O.OverloadedMethodInfo ActiveConnectionGetUuidMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.ActiveConnection.activeConnectionGetUuid",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-ActiveConnection.html#v:activeConnectionGetUuid"
})
#endif
foreign import ccall "nm_active_connection_get_vpn" nm_active_connection_get_vpn ::
Ptr ActiveConnection ->
IO CInt
activeConnectionGetVpn ::
(B.CallStack.HasCallStack, MonadIO m, IsActiveConnection a) =>
a
-> m Bool
activeConnectionGetVpn :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsActiveConnection a) =>
a -> m Bool
activeConnectionGetVpn a
connection = 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 ActiveConnection
connection' <- a -> IO (Ptr ActiveConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
CInt
result <- Ptr ActiveConnection -> IO CInt
nm_active_connection_get_vpn Ptr ActiveConnection
connection'
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
connection
Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data ActiveConnectionGetVpnMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsActiveConnection a) => O.OverloadedMethod ActiveConnectionGetVpnMethodInfo a signature where
overloadedMethod = activeConnectionGetVpn
instance O.OverloadedMethodInfo ActiveConnectionGetVpnMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.ActiveConnection.activeConnectionGetVpn",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-ActiveConnection.html#v:activeConnectionGetVpn"
})
#endif