{-# LANGUAGE TypeApplications #-}
#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif
module GI.NM.Objects.DeviceIPTunnel
(
DeviceIPTunnel(..) ,
IsDeviceIPTunnel ,
toDeviceIPTunnel ,
#if defined(ENABLE_OVERLOADING)
ResolveDeviceIPTunnelMethod ,
#endif
#if defined(ENABLE_OVERLOADING)
DeviceIPTunnelGetEncapsulationLimitMethodInfo,
#endif
deviceIPTunnelGetEncapsulationLimit ,
#if defined(ENABLE_OVERLOADING)
DeviceIPTunnelGetFlagsMethodInfo ,
#endif
deviceIPTunnelGetFlags ,
#if defined(ENABLE_OVERLOADING)
DeviceIPTunnelGetFlowLabelMethodInfo ,
#endif
deviceIPTunnelGetFlowLabel ,
#if defined(ENABLE_OVERLOADING)
DeviceIPTunnelGetFwmarkMethodInfo ,
#endif
deviceIPTunnelGetFwmark ,
#if defined(ENABLE_OVERLOADING)
DeviceIPTunnelGetInputKeyMethodInfo ,
#endif
deviceIPTunnelGetInputKey ,
#if defined(ENABLE_OVERLOADING)
DeviceIPTunnelGetLocalMethodInfo ,
#endif
deviceIPTunnelGetLocal ,
#if defined(ENABLE_OVERLOADING)
DeviceIPTunnelGetModeMethodInfo ,
#endif
deviceIPTunnelGetMode ,
#if defined(ENABLE_OVERLOADING)
DeviceIPTunnelGetOutputKeyMethodInfo ,
#endif
deviceIPTunnelGetOutputKey ,
#if defined(ENABLE_OVERLOADING)
DeviceIPTunnelGetParentMethodInfo ,
#endif
deviceIPTunnelGetParent ,
#if defined(ENABLE_OVERLOADING)
DeviceIPTunnelGetPathMtuDiscoveryMethodInfo,
#endif
deviceIPTunnelGetPathMtuDiscovery ,
#if defined(ENABLE_OVERLOADING)
DeviceIPTunnelGetRemoteMethodInfo ,
#endif
deviceIPTunnelGetRemote ,
#if defined(ENABLE_OVERLOADING)
DeviceIPTunnelGetTosMethodInfo ,
#endif
deviceIPTunnelGetTos ,
#if defined(ENABLE_OVERLOADING)
DeviceIPTunnelGetTtlMethodInfo ,
#endif
deviceIPTunnelGetTtl ,
#if defined(ENABLE_OVERLOADING)
DeviceIPTunnelEncapsulationLimitPropertyInfo,
#endif
#if defined(ENABLE_OVERLOADING)
deviceIPTunnelEncapsulationLimit ,
#endif
#if defined(ENABLE_OVERLOADING)
DeviceIPTunnelFlagsPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
deviceIPTunnelFlags ,
#endif
getDeviceIPTunnelFlags ,
#if defined(ENABLE_OVERLOADING)
DeviceIPTunnelFlowLabelPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
deviceIPTunnelFlowLabel ,
#endif
getDeviceIPTunnelFlowLabel ,
#if defined(ENABLE_OVERLOADING)
DeviceIPTunnelFwmarkPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
deviceIPTunnelFwmark ,
#endif
getDeviceIPTunnelFwmark ,
#if defined(ENABLE_OVERLOADING)
DeviceIPTunnelInputKeyPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
deviceIPTunnelInputKey ,
#endif
getDeviceIPTunnelInputKey ,
#if defined(ENABLE_OVERLOADING)
DeviceIPTunnelLocalPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
deviceIPTunnelLocal ,
#endif
getDeviceIPTunnelLocal ,
#if defined(ENABLE_OVERLOADING)
DeviceIPTunnelModePropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
deviceIPTunnelMode ,
#endif
getDeviceIPTunnelMode ,
#if defined(ENABLE_OVERLOADING)
DeviceIPTunnelOutputKeyPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
deviceIPTunnelOutputKey ,
#endif
getDeviceIPTunnelOutputKey ,
#if defined(ENABLE_OVERLOADING)
DeviceIPTunnelParentPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
deviceIPTunnelParent ,
#endif
getDeviceIPTunnelParent ,
#if defined(ENABLE_OVERLOADING)
DeviceIPTunnelPathMtuDiscoveryPropertyInfo,
#endif
#if defined(ENABLE_OVERLOADING)
deviceIPTunnelPathMtuDiscovery ,
#endif
getDeviceIPTunnelPathMtuDiscovery ,
#if defined(ENABLE_OVERLOADING)
DeviceIPTunnelRemotePropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
deviceIPTunnelRemote ,
#endif
getDeviceIPTunnelRemote ,
#if defined(ENABLE_OVERLOADING)
DeviceIPTunnelTosPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
deviceIPTunnelTos ,
#endif
#if defined(ENABLE_OVERLOADING)
DeviceIPTunnelTtlPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
deviceIPTunnelTtl ,
#endif
) 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.ActiveConnection as NM.ActiveConnection
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.Object as NM.Object
#endif
newtype DeviceIPTunnel = DeviceIPTunnel (SP.ManagedPtr DeviceIPTunnel)
deriving (DeviceIPTunnel -> DeviceIPTunnel -> Bool
(DeviceIPTunnel -> DeviceIPTunnel -> Bool)
-> (DeviceIPTunnel -> DeviceIPTunnel -> Bool) -> Eq DeviceIPTunnel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeviceIPTunnel -> DeviceIPTunnel -> Bool
== :: DeviceIPTunnel -> DeviceIPTunnel -> Bool
$c/= :: DeviceIPTunnel -> DeviceIPTunnel -> Bool
/= :: DeviceIPTunnel -> DeviceIPTunnel -> Bool
Eq)
instance SP.ManagedPtrNewtype DeviceIPTunnel where
toManagedPtr :: DeviceIPTunnel -> ManagedPtr DeviceIPTunnel
toManagedPtr (DeviceIPTunnel ManagedPtr DeviceIPTunnel
p) = ManagedPtr DeviceIPTunnel
p
foreign import ccall "nm_device_ip_tunnel_get_type"
c_nm_device_ip_tunnel_get_type :: IO B.Types.GType
instance B.Types.TypedObject DeviceIPTunnel where
glibType :: IO GType
glibType = IO GType
c_nm_device_ip_tunnel_get_type
instance B.Types.GObject DeviceIPTunnel
class (SP.GObject o, O.IsDescendantOf DeviceIPTunnel o) => IsDeviceIPTunnel o
instance (SP.GObject o, O.IsDescendantOf DeviceIPTunnel o) => IsDeviceIPTunnel o
instance O.HasParentTypes DeviceIPTunnel
type instance O.ParentTypes DeviceIPTunnel = '[NM.Device.Device, NM.Object.Object, GObject.Object.Object]
toDeviceIPTunnel :: (MIO.MonadIO m, IsDeviceIPTunnel o) => o -> m DeviceIPTunnel
toDeviceIPTunnel :: forall (m :: * -> *) o.
(MonadIO m, IsDeviceIPTunnel o) =>
o -> m DeviceIPTunnel
toDeviceIPTunnel = IO DeviceIPTunnel -> m DeviceIPTunnel
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO DeviceIPTunnel -> m DeviceIPTunnel)
-> (o -> IO DeviceIPTunnel) -> o -> m DeviceIPTunnel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr DeviceIPTunnel -> DeviceIPTunnel)
-> o -> IO DeviceIPTunnel
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr DeviceIPTunnel -> DeviceIPTunnel
DeviceIPTunnel
instance B.GValue.IsGValue (Maybe DeviceIPTunnel) where
gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_nm_device_ip_tunnel_get_type
gvalueSet_ :: Ptr GValue -> Maybe DeviceIPTunnel -> IO ()
gvalueSet_ Ptr GValue
gv Maybe DeviceIPTunnel
P.Nothing = Ptr GValue -> Ptr DeviceIPTunnel -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr DeviceIPTunnel
forall a. Ptr a
FP.nullPtr :: FP.Ptr DeviceIPTunnel)
gvalueSet_ Ptr GValue
gv (P.Just DeviceIPTunnel
obj) = DeviceIPTunnel -> (Ptr DeviceIPTunnel -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr DeviceIPTunnel
obj (Ptr GValue -> Ptr DeviceIPTunnel -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
gvalueGet_ :: Ptr GValue -> IO (Maybe DeviceIPTunnel)
gvalueGet_ Ptr GValue
gv = do
Ptr DeviceIPTunnel
ptr <- Ptr GValue -> IO (Ptr DeviceIPTunnel)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr DeviceIPTunnel)
if Ptr DeviceIPTunnel
ptr Ptr DeviceIPTunnel -> Ptr DeviceIPTunnel -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr DeviceIPTunnel
forall a. Ptr a
FP.nullPtr
then DeviceIPTunnel -> Maybe DeviceIPTunnel
forall a. a -> Maybe a
P.Just (DeviceIPTunnel -> Maybe DeviceIPTunnel)
-> IO DeviceIPTunnel -> IO (Maybe DeviceIPTunnel)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr DeviceIPTunnel -> DeviceIPTunnel)
-> Ptr DeviceIPTunnel -> IO DeviceIPTunnel
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr DeviceIPTunnel -> DeviceIPTunnel
DeviceIPTunnel Ptr DeviceIPTunnel
ptr
else Maybe DeviceIPTunnel -> IO (Maybe DeviceIPTunnel)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DeviceIPTunnel
forall a. Maybe a
P.Nothing
#if defined(ENABLE_OVERLOADING)
type family ResolveDeviceIPTunnelMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
ResolveDeviceIPTunnelMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
ResolveDeviceIPTunnelMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
ResolveDeviceIPTunnelMethod "connectionCompatible" o = NM.Device.DeviceConnectionCompatibleMethodInfo
ResolveDeviceIPTunnelMethod "connectionValid" o = NM.Device.DeviceConnectionValidMethodInfo
ResolveDeviceIPTunnelMethod "delete" o = NM.Device.DeviceDeleteMethodInfo
ResolveDeviceIPTunnelMethod "deleteAsync" o = NM.Device.DeviceDeleteAsyncMethodInfo
ResolveDeviceIPTunnelMethod "deleteFinish" o = NM.Device.DeviceDeleteFinishMethodInfo
ResolveDeviceIPTunnelMethod "disconnect" o = NM.Device.DeviceDisconnectMethodInfo
ResolveDeviceIPTunnelMethod "disconnectAsync" o = NM.Device.DeviceDisconnectAsyncMethodInfo
ResolveDeviceIPTunnelMethod "disconnectFinish" o = NM.Device.DeviceDisconnectFinishMethodInfo
ResolveDeviceIPTunnelMethod "filterConnections" o = NM.Device.DeviceFilterConnectionsMethodInfo
ResolveDeviceIPTunnelMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
ResolveDeviceIPTunnelMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
ResolveDeviceIPTunnelMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
ResolveDeviceIPTunnelMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
ResolveDeviceIPTunnelMethod "isReal" o = NM.Device.DeviceIsRealMethodInfo
ResolveDeviceIPTunnelMethod "isSoftware" o = NM.Device.DeviceIsSoftwareMethodInfo
ResolveDeviceIPTunnelMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
ResolveDeviceIPTunnelMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
ResolveDeviceIPTunnelMethod "reapply" o = NM.Device.DeviceReapplyMethodInfo
ResolveDeviceIPTunnelMethod "reapplyAsync" o = NM.Device.DeviceReapplyAsyncMethodInfo
ResolveDeviceIPTunnelMethod "reapplyFinish" o = NM.Device.DeviceReapplyFinishMethodInfo
ResolveDeviceIPTunnelMethod "ref" o = GObject.Object.ObjectRefMethodInfo
ResolveDeviceIPTunnelMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
ResolveDeviceIPTunnelMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
ResolveDeviceIPTunnelMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
ResolveDeviceIPTunnelMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
ResolveDeviceIPTunnelMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
ResolveDeviceIPTunnelMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
ResolveDeviceIPTunnelMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
ResolveDeviceIPTunnelMethod "getActiveConnection" o = NM.Device.DeviceGetActiveConnectionMethodInfo
ResolveDeviceIPTunnelMethod "getAppliedConnection" o = NM.Device.DeviceGetAppliedConnectionMethodInfo
ResolveDeviceIPTunnelMethod "getAppliedConnectionAsync" o = NM.Device.DeviceGetAppliedConnectionAsyncMethodInfo
ResolveDeviceIPTunnelMethod "getAppliedConnectionFinish" o = NM.Device.DeviceGetAppliedConnectionFinishMethodInfo
ResolveDeviceIPTunnelMethod "getAutoconnect" o = NM.Device.DeviceGetAutoconnectMethodInfo
ResolveDeviceIPTunnelMethod "getAvailableConnections" o = NM.Device.DeviceGetAvailableConnectionsMethodInfo
ResolveDeviceIPTunnelMethod "getCapabilities" o = NM.Device.DeviceGetCapabilitiesMethodInfo
ResolveDeviceIPTunnelMethod "getClient" o = NM.Object.ObjectGetClientMethodInfo
ResolveDeviceIPTunnelMethod "getConnectivity" o = NM.Device.DeviceGetConnectivityMethodInfo
ResolveDeviceIPTunnelMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
ResolveDeviceIPTunnelMethod "getDescription" o = NM.Device.DeviceGetDescriptionMethodInfo
ResolveDeviceIPTunnelMethod "getDeviceType" o = NM.Device.DeviceGetDeviceTypeMethodInfo
ResolveDeviceIPTunnelMethod "getDhcp4Config" o = NM.Device.DeviceGetDhcp4ConfigMethodInfo
ResolveDeviceIPTunnelMethod "getDhcp6Config" o = NM.Device.DeviceGetDhcp6ConfigMethodInfo
ResolveDeviceIPTunnelMethod "getDriver" o = NM.Device.DeviceGetDriverMethodInfo
ResolveDeviceIPTunnelMethod "getDriverVersion" o = NM.Device.DeviceGetDriverVersionMethodInfo
ResolveDeviceIPTunnelMethod "getEncapsulationLimit" o = DeviceIPTunnelGetEncapsulationLimitMethodInfo
ResolveDeviceIPTunnelMethod "getFirmwareMissing" o = NM.Device.DeviceGetFirmwareMissingMethodInfo
ResolveDeviceIPTunnelMethod "getFirmwareVersion" o = NM.Device.DeviceGetFirmwareVersionMethodInfo
ResolveDeviceIPTunnelMethod "getFlags" o = DeviceIPTunnelGetFlagsMethodInfo
ResolveDeviceIPTunnelMethod "getFlowLabel" o = DeviceIPTunnelGetFlowLabelMethodInfo
ResolveDeviceIPTunnelMethod "getFwmark" o = DeviceIPTunnelGetFwmarkMethodInfo
ResolveDeviceIPTunnelMethod "getHwAddress" o = NM.Device.DeviceGetHwAddressMethodInfo
ResolveDeviceIPTunnelMethod "getIface" o = NM.Device.DeviceGetIfaceMethodInfo
ResolveDeviceIPTunnelMethod "getInputKey" o = DeviceIPTunnelGetInputKeyMethodInfo
ResolveDeviceIPTunnelMethod "getInterfaceFlags" o = NM.Device.DeviceGetInterfaceFlagsMethodInfo
ResolveDeviceIPTunnelMethod "getIp4Config" o = NM.Device.DeviceGetIp4ConfigMethodInfo
ResolveDeviceIPTunnelMethod "getIp6Config" o = NM.Device.DeviceGetIp6ConfigMethodInfo
ResolveDeviceIPTunnelMethod "getIpIface" o = NM.Device.DeviceGetIpIfaceMethodInfo
ResolveDeviceIPTunnelMethod "getLldpNeighbors" o = NM.Device.DeviceGetLldpNeighborsMethodInfo
ResolveDeviceIPTunnelMethod "getLocal" o = DeviceIPTunnelGetLocalMethodInfo
ResolveDeviceIPTunnelMethod "getManaged" o = NM.Device.DeviceGetManagedMethodInfo
ResolveDeviceIPTunnelMethod "getMetered" o = NM.Device.DeviceGetMeteredMethodInfo
ResolveDeviceIPTunnelMethod "getMode" o = DeviceIPTunnelGetModeMethodInfo
ResolveDeviceIPTunnelMethod "getMtu" o = NM.Device.DeviceGetMtuMethodInfo
ResolveDeviceIPTunnelMethod "getNmPluginMissing" o = NM.Device.DeviceGetNmPluginMissingMethodInfo
ResolveDeviceIPTunnelMethod "getOutputKey" o = DeviceIPTunnelGetOutputKeyMethodInfo
ResolveDeviceIPTunnelMethod "getParent" o = DeviceIPTunnelGetParentMethodInfo
ResolveDeviceIPTunnelMethod "getPath" o = NM.Device.DeviceGetPathMethodInfo
ResolveDeviceIPTunnelMethod "getPathMtuDiscovery" o = DeviceIPTunnelGetPathMtuDiscoveryMethodInfo
ResolveDeviceIPTunnelMethod "getPhysicalPortId" o = NM.Device.DeviceGetPhysicalPortIdMethodInfo
ResolveDeviceIPTunnelMethod "getPorts" o = NM.Device.DeviceGetPortsMethodInfo
ResolveDeviceIPTunnelMethod "getProduct" o = NM.Device.DeviceGetProductMethodInfo
ResolveDeviceIPTunnelMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
ResolveDeviceIPTunnelMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
ResolveDeviceIPTunnelMethod "getRemote" o = DeviceIPTunnelGetRemoteMethodInfo
ResolveDeviceIPTunnelMethod "getSettingType" o = NM.Device.DeviceGetSettingTypeMethodInfo
ResolveDeviceIPTunnelMethod "getState" o = NM.Device.DeviceGetStateMethodInfo
ResolveDeviceIPTunnelMethod "getStateReason" o = NM.Device.DeviceGetStateReasonMethodInfo
ResolveDeviceIPTunnelMethod "getTos" o = DeviceIPTunnelGetTosMethodInfo
ResolveDeviceIPTunnelMethod "getTtl" o = DeviceIPTunnelGetTtlMethodInfo
ResolveDeviceIPTunnelMethod "getTypeDescription" o = NM.Device.DeviceGetTypeDescriptionMethodInfo
ResolveDeviceIPTunnelMethod "getUdi" o = NM.Device.DeviceGetUdiMethodInfo
ResolveDeviceIPTunnelMethod "getVendor" o = NM.Device.DeviceGetVendorMethodInfo
ResolveDeviceIPTunnelMethod "setAutoconnect" o = NM.Device.DeviceSetAutoconnectMethodInfo
ResolveDeviceIPTunnelMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
ResolveDeviceIPTunnelMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
ResolveDeviceIPTunnelMethod "setManaged" o = NM.Device.DeviceSetManagedMethodInfo
ResolveDeviceIPTunnelMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
ResolveDeviceIPTunnelMethod l o = O.MethodResolutionFailed l o
instance (info ~ ResolveDeviceIPTunnelMethod t DeviceIPTunnel, O.OverloadedMethod info DeviceIPTunnel p) => OL.IsLabel t (DeviceIPTunnel -> 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 ~ ResolveDeviceIPTunnelMethod t DeviceIPTunnel, O.OverloadedMethod info DeviceIPTunnel p, R.HasField t DeviceIPTunnel p) => R.HasField t DeviceIPTunnel p where
getField = O.overloadedMethod @info
#endif
instance (info ~ ResolveDeviceIPTunnelMethod t DeviceIPTunnel, O.OverloadedMethodInfo info DeviceIPTunnel) => OL.IsLabel t (O.MethodProxy info DeviceIPTunnel) where
#if MIN_VERSION_base(4,10,0)
fromLabel = O.MethodProxy
#else
fromLabel _ = O.MethodProxy
#endif
#endif
#if defined(ENABLE_OVERLOADING)
data DeviceIPTunnelEncapsulationLimitPropertyInfo
instance AttrInfo DeviceIPTunnelEncapsulationLimitPropertyInfo where
type AttrAllowedOps DeviceIPTunnelEncapsulationLimitPropertyInfo = '[]
type AttrSetTypeConstraint DeviceIPTunnelEncapsulationLimitPropertyInfo = (~) ()
type AttrTransferTypeConstraint DeviceIPTunnelEncapsulationLimitPropertyInfo = (~) ()
type AttrTransferType DeviceIPTunnelEncapsulationLimitPropertyInfo = ()
type AttrBaseTypeConstraint DeviceIPTunnelEncapsulationLimitPropertyInfo = (~) ()
type AttrGetType DeviceIPTunnelEncapsulationLimitPropertyInfo = ()
type AttrLabel DeviceIPTunnelEncapsulationLimitPropertyInfo = ""
type AttrOrigin DeviceIPTunnelEncapsulationLimitPropertyInfo = DeviceIPTunnel
attrGet = undefined
attrSet = undefined
attrConstruct = undefined
attrClear = undefined
attrTransfer = undefined
#endif
getDeviceIPTunnelFlags :: (MonadIO m, IsDeviceIPTunnel o) => o -> m Word32
getDeviceIPTunnelFlags :: forall (m :: * -> *) o.
(MonadIO m, IsDeviceIPTunnel o) =>
o -> m Word32
getDeviceIPTunnelFlags 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
"flags"
#if defined(ENABLE_OVERLOADING)
data DeviceIPTunnelFlagsPropertyInfo
instance AttrInfo DeviceIPTunnelFlagsPropertyInfo where
type AttrAllowedOps DeviceIPTunnelFlagsPropertyInfo = '[ 'AttrGet]
type AttrBaseTypeConstraint DeviceIPTunnelFlagsPropertyInfo = IsDeviceIPTunnel
type AttrSetTypeConstraint DeviceIPTunnelFlagsPropertyInfo = (~) ()
type AttrTransferTypeConstraint DeviceIPTunnelFlagsPropertyInfo = (~) ()
type AttrTransferType DeviceIPTunnelFlagsPropertyInfo = ()
type AttrGetType DeviceIPTunnelFlagsPropertyInfo = Word32
type AttrLabel DeviceIPTunnelFlagsPropertyInfo = "flags"
type AttrOrigin DeviceIPTunnelFlagsPropertyInfo = DeviceIPTunnel
attrGet = getDeviceIPTunnelFlags
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceIPTunnel.flags"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceIPTunnel.html#g:attr:flags"
})
#endif
getDeviceIPTunnelFlowLabel :: (MonadIO m, IsDeviceIPTunnel o) => o -> m Word32
getDeviceIPTunnelFlowLabel :: forall (m :: * -> *) o.
(MonadIO m, IsDeviceIPTunnel o) =>
o -> m Word32
getDeviceIPTunnelFlowLabel 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
"flow-label"
#if defined(ENABLE_OVERLOADING)
data DeviceIPTunnelFlowLabelPropertyInfo
instance AttrInfo DeviceIPTunnelFlowLabelPropertyInfo where
type AttrAllowedOps DeviceIPTunnelFlowLabelPropertyInfo = '[ 'AttrGet]
type AttrBaseTypeConstraint DeviceIPTunnelFlowLabelPropertyInfo = IsDeviceIPTunnel
type AttrSetTypeConstraint DeviceIPTunnelFlowLabelPropertyInfo = (~) ()
type AttrTransferTypeConstraint DeviceIPTunnelFlowLabelPropertyInfo = (~) ()
type AttrTransferType DeviceIPTunnelFlowLabelPropertyInfo = ()
type AttrGetType DeviceIPTunnelFlowLabelPropertyInfo = Word32
type AttrLabel DeviceIPTunnelFlowLabelPropertyInfo = "flow-label"
type AttrOrigin DeviceIPTunnelFlowLabelPropertyInfo = DeviceIPTunnel
attrGet = getDeviceIPTunnelFlowLabel
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceIPTunnel.flowLabel"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceIPTunnel.html#g:attr:flowLabel"
})
#endif
getDeviceIPTunnelFwmark :: (MonadIO m, IsDeviceIPTunnel o) => o -> m Word32
getDeviceIPTunnelFwmark :: forall (m :: * -> *) o.
(MonadIO m, IsDeviceIPTunnel o) =>
o -> m Word32
getDeviceIPTunnelFwmark 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
"fwmark"
#if defined(ENABLE_OVERLOADING)
data DeviceIPTunnelFwmarkPropertyInfo
instance AttrInfo DeviceIPTunnelFwmarkPropertyInfo where
type AttrAllowedOps DeviceIPTunnelFwmarkPropertyInfo = '[ 'AttrGet]
type AttrBaseTypeConstraint DeviceIPTunnelFwmarkPropertyInfo = IsDeviceIPTunnel
type AttrSetTypeConstraint DeviceIPTunnelFwmarkPropertyInfo = (~) ()
type AttrTransferTypeConstraint DeviceIPTunnelFwmarkPropertyInfo = (~) ()
type AttrTransferType DeviceIPTunnelFwmarkPropertyInfo = ()
type AttrGetType DeviceIPTunnelFwmarkPropertyInfo = Word32
type AttrLabel DeviceIPTunnelFwmarkPropertyInfo = "fwmark"
type AttrOrigin DeviceIPTunnelFwmarkPropertyInfo = DeviceIPTunnel
attrGet = getDeviceIPTunnelFwmark
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceIPTunnel.fwmark"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceIPTunnel.html#g:attr:fwmark"
})
#endif
getDeviceIPTunnelInputKey :: (MonadIO m, IsDeviceIPTunnel o) => o -> m T.Text
getDeviceIPTunnelInputKey :: forall (m :: * -> *) o.
(MonadIO m, IsDeviceIPTunnel o) =>
o -> m Text
getDeviceIPTunnelInputKey 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
"getDeviceIPTunnelInputKey" (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
"input-key"
#if defined(ENABLE_OVERLOADING)
data DeviceIPTunnelInputKeyPropertyInfo
instance AttrInfo DeviceIPTunnelInputKeyPropertyInfo where
type AttrAllowedOps DeviceIPTunnelInputKeyPropertyInfo = '[ 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint DeviceIPTunnelInputKeyPropertyInfo = IsDeviceIPTunnel
type AttrSetTypeConstraint DeviceIPTunnelInputKeyPropertyInfo = (~) ()
type AttrTransferTypeConstraint DeviceIPTunnelInputKeyPropertyInfo = (~) ()
type AttrTransferType DeviceIPTunnelInputKeyPropertyInfo = ()
type AttrGetType DeviceIPTunnelInputKeyPropertyInfo = T.Text
type AttrLabel DeviceIPTunnelInputKeyPropertyInfo = "input-key"
type AttrOrigin DeviceIPTunnelInputKeyPropertyInfo = DeviceIPTunnel
attrGet = getDeviceIPTunnelInputKey
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceIPTunnel.inputKey"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceIPTunnel.html#g:attr:inputKey"
})
#endif
getDeviceIPTunnelLocal :: (MonadIO m, IsDeviceIPTunnel o) => o -> m T.Text
getDeviceIPTunnelLocal :: forall (m :: * -> *) o.
(MonadIO m, IsDeviceIPTunnel o) =>
o -> m Text
getDeviceIPTunnelLocal 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
"getDeviceIPTunnelLocal" (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
"local"
#if defined(ENABLE_OVERLOADING)
data DeviceIPTunnelLocalPropertyInfo
instance AttrInfo DeviceIPTunnelLocalPropertyInfo where
type AttrAllowedOps DeviceIPTunnelLocalPropertyInfo = '[ 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint DeviceIPTunnelLocalPropertyInfo = IsDeviceIPTunnel
type AttrSetTypeConstraint DeviceIPTunnelLocalPropertyInfo = (~) ()
type AttrTransferTypeConstraint DeviceIPTunnelLocalPropertyInfo = (~) ()
type AttrTransferType DeviceIPTunnelLocalPropertyInfo = ()
type AttrGetType DeviceIPTunnelLocalPropertyInfo = T.Text
type AttrLabel DeviceIPTunnelLocalPropertyInfo = "local"
type AttrOrigin DeviceIPTunnelLocalPropertyInfo = DeviceIPTunnel
attrGet = getDeviceIPTunnelLocal
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceIPTunnel.local"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceIPTunnel.html#g:attr:local"
})
#endif
getDeviceIPTunnelMode :: (MonadIO m, IsDeviceIPTunnel o) => o -> m Word32
getDeviceIPTunnelMode :: forall (m :: * -> *) o.
(MonadIO m, IsDeviceIPTunnel o) =>
o -> m Word32
getDeviceIPTunnelMode 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
"mode"
#if defined(ENABLE_OVERLOADING)
data DeviceIPTunnelModePropertyInfo
instance AttrInfo DeviceIPTunnelModePropertyInfo where
type AttrAllowedOps DeviceIPTunnelModePropertyInfo = '[ 'AttrGet]
type AttrBaseTypeConstraint DeviceIPTunnelModePropertyInfo = IsDeviceIPTunnel
type AttrSetTypeConstraint DeviceIPTunnelModePropertyInfo = (~) ()
type AttrTransferTypeConstraint DeviceIPTunnelModePropertyInfo = (~) ()
type AttrTransferType DeviceIPTunnelModePropertyInfo = ()
type AttrGetType DeviceIPTunnelModePropertyInfo = Word32
type AttrLabel DeviceIPTunnelModePropertyInfo = "mode"
type AttrOrigin DeviceIPTunnelModePropertyInfo = DeviceIPTunnel
attrGet = getDeviceIPTunnelMode
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceIPTunnel.mode"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceIPTunnel.html#g:attr:mode"
})
#endif
getDeviceIPTunnelOutputKey :: (MonadIO m, IsDeviceIPTunnel o) => o -> m T.Text
getDeviceIPTunnelOutputKey :: forall (m :: * -> *) o.
(MonadIO m, IsDeviceIPTunnel o) =>
o -> m Text
getDeviceIPTunnelOutputKey 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
"getDeviceIPTunnelOutputKey" (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
"output-key"
#if defined(ENABLE_OVERLOADING)
data DeviceIPTunnelOutputKeyPropertyInfo
instance AttrInfo DeviceIPTunnelOutputKeyPropertyInfo where
type AttrAllowedOps DeviceIPTunnelOutputKeyPropertyInfo = '[ 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint DeviceIPTunnelOutputKeyPropertyInfo = IsDeviceIPTunnel
type AttrSetTypeConstraint DeviceIPTunnelOutputKeyPropertyInfo = (~) ()
type AttrTransferTypeConstraint DeviceIPTunnelOutputKeyPropertyInfo = (~) ()
type AttrTransferType DeviceIPTunnelOutputKeyPropertyInfo = ()
type AttrGetType DeviceIPTunnelOutputKeyPropertyInfo = T.Text
type AttrLabel DeviceIPTunnelOutputKeyPropertyInfo = "output-key"
type AttrOrigin DeviceIPTunnelOutputKeyPropertyInfo = DeviceIPTunnel
attrGet = getDeviceIPTunnelOutputKey
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceIPTunnel.outputKey"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceIPTunnel.html#g:attr:outputKey"
})
#endif
getDeviceIPTunnelParent :: (MonadIO m, IsDeviceIPTunnel o) => o -> m NM.Device.Device
getDeviceIPTunnelParent :: forall (m :: * -> *) o.
(MonadIO m, IsDeviceIPTunnel o) =>
o -> m Device
getDeviceIPTunnelParent o
obj = IO Device -> m Device
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Device -> m Device) -> IO Device -> m Device
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Device) -> IO Device
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getDeviceIPTunnelParent" (IO (Maybe Device) -> IO Device) -> IO (Maybe Device) -> IO 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
"parent" ManagedPtr Device -> Device
NM.Device.Device
#if defined(ENABLE_OVERLOADING)
data DeviceIPTunnelParentPropertyInfo
instance AttrInfo DeviceIPTunnelParentPropertyInfo where
type AttrAllowedOps DeviceIPTunnelParentPropertyInfo = '[ 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint DeviceIPTunnelParentPropertyInfo = IsDeviceIPTunnel
type AttrSetTypeConstraint DeviceIPTunnelParentPropertyInfo = (~) ()
type AttrTransferTypeConstraint DeviceIPTunnelParentPropertyInfo = (~) ()
type AttrTransferType DeviceIPTunnelParentPropertyInfo = ()
type AttrGetType DeviceIPTunnelParentPropertyInfo = NM.Device.Device
type AttrLabel DeviceIPTunnelParentPropertyInfo = "parent"
type AttrOrigin DeviceIPTunnelParentPropertyInfo = DeviceIPTunnel
attrGet = getDeviceIPTunnelParent
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceIPTunnel.parent"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceIPTunnel.html#g:attr:parent"
})
#endif
getDeviceIPTunnelPathMtuDiscovery :: (MonadIO m, IsDeviceIPTunnel o) => o -> m Bool
getDeviceIPTunnelPathMtuDiscovery :: forall (m :: * -> *) o.
(MonadIO m, IsDeviceIPTunnel o) =>
o -> m Bool
getDeviceIPTunnelPathMtuDiscovery 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
"path-mtu-discovery"
#if defined(ENABLE_OVERLOADING)
data DeviceIPTunnelPathMtuDiscoveryPropertyInfo
instance AttrInfo DeviceIPTunnelPathMtuDiscoveryPropertyInfo where
type AttrAllowedOps DeviceIPTunnelPathMtuDiscoveryPropertyInfo = '[ 'AttrGet]
type AttrBaseTypeConstraint DeviceIPTunnelPathMtuDiscoveryPropertyInfo = IsDeviceIPTunnel
type AttrSetTypeConstraint DeviceIPTunnelPathMtuDiscoveryPropertyInfo = (~) ()
type AttrTransferTypeConstraint DeviceIPTunnelPathMtuDiscoveryPropertyInfo = (~) ()
type AttrTransferType DeviceIPTunnelPathMtuDiscoveryPropertyInfo = ()
type AttrGetType DeviceIPTunnelPathMtuDiscoveryPropertyInfo = Bool
type AttrLabel DeviceIPTunnelPathMtuDiscoveryPropertyInfo = "path-mtu-discovery"
type AttrOrigin DeviceIPTunnelPathMtuDiscoveryPropertyInfo = DeviceIPTunnel
attrGet = getDeviceIPTunnelPathMtuDiscovery
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceIPTunnel.pathMtuDiscovery"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceIPTunnel.html#g:attr:pathMtuDiscovery"
})
#endif
getDeviceIPTunnelRemote :: (MonadIO m, IsDeviceIPTunnel o) => o -> m T.Text
getDeviceIPTunnelRemote :: forall (m :: * -> *) o.
(MonadIO m, IsDeviceIPTunnel o) =>
o -> m Text
getDeviceIPTunnelRemote 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
"getDeviceIPTunnelRemote" (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
"remote"
#if defined(ENABLE_OVERLOADING)
data DeviceIPTunnelRemotePropertyInfo
instance AttrInfo DeviceIPTunnelRemotePropertyInfo where
type AttrAllowedOps DeviceIPTunnelRemotePropertyInfo = '[ 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint DeviceIPTunnelRemotePropertyInfo = IsDeviceIPTunnel
type AttrSetTypeConstraint DeviceIPTunnelRemotePropertyInfo = (~) ()
type AttrTransferTypeConstraint DeviceIPTunnelRemotePropertyInfo = (~) ()
type AttrTransferType DeviceIPTunnelRemotePropertyInfo = ()
type AttrGetType DeviceIPTunnelRemotePropertyInfo = T.Text
type AttrLabel DeviceIPTunnelRemotePropertyInfo = "remote"
type AttrOrigin DeviceIPTunnelRemotePropertyInfo = DeviceIPTunnel
attrGet = getDeviceIPTunnelRemote
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceIPTunnel.remote"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceIPTunnel.html#g:attr:remote"
})
#endif
#if defined(ENABLE_OVERLOADING)
data DeviceIPTunnelTosPropertyInfo
instance AttrInfo DeviceIPTunnelTosPropertyInfo where
type AttrAllowedOps DeviceIPTunnelTosPropertyInfo = '[]
type AttrSetTypeConstraint DeviceIPTunnelTosPropertyInfo = (~) ()
type AttrTransferTypeConstraint DeviceIPTunnelTosPropertyInfo = (~) ()
type AttrTransferType DeviceIPTunnelTosPropertyInfo = ()
type AttrBaseTypeConstraint DeviceIPTunnelTosPropertyInfo = (~) ()
type AttrGetType DeviceIPTunnelTosPropertyInfo = ()
type AttrLabel DeviceIPTunnelTosPropertyInfo = ""
type AttrOrigin DeviceIPTunnelTosPropertyInfo = DeviceIPTunnel
attrGet = undefined
attrSet = undefined
attrConstruct = undefined
attrClear = undefined
attrTransfer = undefined
#endif
#if defined(ENABLE_OVERLOADING)
data DeviceIPTunnelTtlPropertyInfo
instance AttrInfo DeviceIPTunnelTtlPropertyInfo where
type AttrAllowedOps DeviceIPTunnelTtlPropertyInfo = '[]
type AttrSetTypeConstraint DeviceIPTunnelTtlPropertyInfo = (~) ()
type AttrTransferTypeConstraint DeviceIPTunnelTtlPropertyInfo = (~) ()
type AttrTransferType DeviceIPTunnelTtlPropertyInfo = ()
type AttrBaseTypeConstraint DeviceIPTunnelTtlPropertyInfo = (~) ()
type AttrGetType DeviceIPTunnelTtlPropertyInfo = ()
type AttrLabel DeviceIPTunnelTtlPropertyInfo = ""
type AttrOrigin DeviceIPTunnelTtlPropertyInfo = DeviceIPTunnel
attrGet = undefined
attrSet = undefined
attrConstruct = undefined
attrClear = undefined
attrTransfer = undefined
#endif
#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList DeviceIPTunnel
type instance O.AttributeList DeviceIPTunnel = DeviceIPTunnelAttributeList
type DeviceIPTunnelAttributeList = ('[ '("activeConnection", NM.Device.DeviceActiveConnectionPropertyInfo), '("autoconnect", NM.Device.DeviceAutoconnectPropertyInfo), '("availableConnections", NM.Device.DeviceAvailableConnectionsPropertyInfo), '("capabilities", NM.Device.DeviceCapabilitiesPropertyInfo), '("client", NM.Object.ObjectClientPropertyInfo), '("deviceType", NM.Device.DeviceDeviceTypePropertyInfo), '("dhcp4Config", NM.Device.DeviceDhcp4ConfigPropertyInfo), '("dhcp6Config", NM.Device.DeviceDhcp6ConfigPropertyInfo), '("driver", NM.Device.DeviceDriverPropertyInfo), '("driverVersion", NM.Device.DeviceDriverVersionPropertyInfo), '("encapsulationLimit", DeviceIPTunnelEncapsulationLimitPropertyInfo), '("firmwareMissing", NM.Device.DeviceFirmwareMissingPropertyInfo), '("firmwareVersion", NM.Device.DeviceFirmwareVersionPropertyInfo), '("flags", DeviceIPTunnelFlagsPropertyInfo), '("flowLabel", DeviceIPTunnelFlowLabelPropertyInfo), '("fwmark", DeviceIPTunnelFwmarkPropertyInfo), '("hwAddress", NM.Device.DeviceHwAddressPropertyInfo), '("inputKey", DeviceIPTunnelInputKeyPropertyInfo), '("interface", NM.Device.DeviceInterfacePropertyInfo), '("interfaceFlags", NM.Device.DeviceInterfaceFlagsPropertyInfo), '("ipInterface", NM.Device.DeviceIpInterfacePropertyInfo), '("ip4Config", NM.Device.DeviceIp4ConfigPropertyInfo), '("ip4Connectivity", NM.Device.DeviceIp4ConnectivityPropertyInfo), '("ip6Config", NM.Device.DeviceIp6ConfigPropertyInfo), '("ip6Connectivity", NM.Device.DeviceIp6ConnectivityPropertyInfo), '("lldpNeighbors", NM.Device.DeviceLldpNeighborsPropertyInfo), '("local", DeviceIPTunnelLocalPropertyInfo), '("managed", NM.Device.DeviceManagedPropertyInfo), '("metered", NM.Device.DeviceMeteredPropertyInfo), '("mode", DeviceIPTunnelModePropertyInfo), '("mtu", NM.Device.DeviceMtuPropertyInfo), '("nmPluginMissing", NM.Device.DeviceNmPluginMissingPropertyInfo), '("outputKey", DeviceIPTunnelOutputKeyPropertyInfo), '("parent", DeviceIPTunnelParentPropertyInfo), '("path", NM.Device.DevicePathPropertyInfo), '("pathMtuDiscovery", DeviceIPTunnelPathMtuDiscoveryPropertyInfo), '("physicalPortId", NM.Device.DevicePhysicalPortIdPropertyInfo), '("ports", NM.Device.DevicePortsPropertyInfo), '("product", NM.Device.DeviceProductPropertyInfo), '("real", NM.Device.DeviceRealPropertyInfo), '("remote", DeviceIPTunnelRemotePropertyInfo), '("state", NM.Device.DeviceStatePropertyInfo), '("stateReason", NM.Device.DeviceStateReasonPropertyInfo), '("tos", DeviceIPTunnelTosPropertyInfo), '("ttl", DeviceIPTunnelTtlPropertyInfo), '("udi", NM.Device.DeviceUdiPropertyInfo), '("vendor", NM.Device.DeviceVendorPropertyInfo)] :: [(Symbol, DK.Type)])
#endif
#if defined(ENABLE_OVERLOADING)
deviceIPTunnelEncapsulationLimit :: AttrLabelProxy "encapsulationLimit"
deviceIPTunnelEncapsulationLimit = AttrLabelProxy
deviceIPTunnelFlags :: AttrLabelProxy "flags"
deviceIPTunnelFlags = AttrLabelProxy
deviceIPTunnelFlowLabel :: AttrLabelProxy "flowLabel"
deviceIPTunnelFlowLabel = AttrLabelProxy
deviceIPTunnelFwmark :: AttrLabelProxy "fwmark"
deviceIPTunnelFwmark = AttrLabelProxy
deviceIPTunnelInputKey :: AttrLabelProxy "inputKey"
deviceIPTunnelInputKey = AttrLabelProxy
deviceIPTunnelLocal :: AttrLabelProxy "local"
deviceIPTunnelLocal = AttrLabelProxy
deviceIPTunnelMode :: AttrLabelProxy "mode"
deviceIPTunnelMode = AttrLabelProxy
deviceIPTunnelOutputKey :: AttrLabelProxy "outputKey"
deviceIPTunnelOutputKey = AttrLabelProxy
deviceIPTunnelParent :: AttrLabelProxy "parent"
deviceIPTunnelParent = AttrLabelProxy
deviceIPTunnelPathMtuDiscovery :: AttrLabelProxy "pathMtuDiscovery"
deviceIPTunnelPathMtuDiscovery = AttrLabelProxy
deviceIPTunnelRemote :: AttrLabelProxy "remote"
deviceIPTunnelRemote = AttrLabelProxy
deviceIPTunnelTos :: AttrLabelProxy "tos"
deviceIPTunnelTos = AttrLabelProxy
deviceIPTunnelTtl :: AttrLabelProxy "ttl"
deviceIPTunnelTtl = AttrLabelProxy
#endif
#if defined(ENABLE_OVERLOADING)
type instance O.SignalList DeviceIPTunnel = DeviceIPTunnelSignalList
type DeviceIPTunnelSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo), '("stateChanged", NM.Device.DeviceStateChangedSignalInfo)] :: [(Symbol, DK.Type)])
#endif
foreign import ccall "nm_device_ip_tunnel_get_encapsulation_limit" nm_device_ip_tunnel_get_encapsulation_limit ::
Ptr DeviceIPTunnel ->
IO Word8
deviceIPTunnelGetEncapsulationLimit ::
(B.CallStack.HasCallStack, MonadIO m, IsDeviceIPTunnel a) =>
a
-> m Word8
deviceIPTunnelGetEncapsulationLimit :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDeviceIPTunnel a) =>
a -> m Word8
deviceIPTunnelGetEncapsulationLimit a
device = IO Word8 -> m Word8
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word8 -> m Word8) -> IO Word8 -> m Word8
forall a b. (a -> b) -> a -> b
$ do
Ptr DeviceIPTunnel
device' <- a -> IO (Ptr DeviceIPTunnel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
Word8
result <- Ptr DeviceIPTunnel -> IO Word8
nm_device_ip_tunnel_get_encapsulation_limit Ptr DeviceIPTunnel
device'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
Word8 -> IO Word8
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
result
#if defined(ENABLE_OVERLOADING)
data DeviceIPTunnelGetEncapsulationLimitMethodInfo
instance (signature ~ (m Word8), MonadIO m, IsDeviceIPTunnel a) => O.OverloadedMethod DeviceIPTunnelGetEncapsulationLimitMethodInfo a signature where
overloadedMethod = deviceIPTunnelGetEncapsulationLimit
instance O.OverloadedMethodInfo DeviceIPTunnelGetEncapsulationLimitMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceIPTunnel.deviceIPTunnelGetEncapsulationLimit",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceIPTunnel.html#v:deviceIPTunnelGetEncapsulationLimit"
})
#endif
foreign import ccall "nm_device_ip_tunnel_get_flags" nm_device_ip_tunnel_get_flags ::
Ptr DeviceIPTunnel ->
IO CUInt
deviceIPTunnelGetFlags ::
(B.CallStack.HasCallStack, MonadIO m, IsDeviceIPTunnel a) =>
a
-> m [NM.Flags.IPTunnelFlags]
deviceIPTunnelGetFlags :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDeviceIPTunnel a) =>
a -> m [IPTunnelFlags]
deviceIPTunnelGetFlags a
device = IO [IPTunnelFlags] -> m [IPTunnelFlags]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [IPTunnelFlags] -> m [IPTunnelFlags])
-> IO [IPTunnelFlags] -> m [IPTunnelFlags]
forall a b. (a -> b) -> a -> b
$ do
Ptr DeviceIPTunnel
device' <- a -> IO (Ptr DeviceIPTunnel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
CUInt
result <- Ptr DeviceIPTunnel -> IO CUInt
nm_device_ip_tunnel_get_flags Ptr DeviceIPTunnel
device'
let result' :: [IPTunnelFlags]
result' = CUInt -> [IPTunnelFlags]
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
device
[IPTunnelFlags] -> IO [IPTunnelFlags]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [IPTunnelFlags]
result'
#if defined(ENABLE_OVERLOADING)
data DeviceIPTunnelGetFlagsMethodInfo
instance (signature ~ (m [NM.Flags.IPTunnelFlags]), MonadIO m, IsDeviceIPTunnel a) => O.OverloadedMethod DeviceIPTunnelGetFlagsMethodInfo a signature where
overloadedMethod = deviceIPTunnelGetFlags
instance O.OverloadedMethodInfo DeviceIPTunnelGetFlagsMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceIPTunnel.deviceIPTunnelGetFlags",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceIPTunnel.html#v:deviceIPTunnelGetFlags"
})
#endif
foreign import ccall "nm_device_ip_tunnel_get_flow_label" nm_device_ip_tunnel_get_flow_label ::
Ptr DeviceIPTunnel ->
IO Word32
deviceIPTunnelGetFlowLabel ::
(B.CallStack.HasCallStack, MonadIO m, IsDeviceIPTunnel a) =>
a
-> m Word32
deviceIPTunnelGetFlowLabel :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDeviceIPTunnel a) =>
a -> m Word32
deviceIPTunnelGetFlowLabel a
device = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
Ptr DeviceIPTunnel
device' <- a -> IO (Ptr DeviceIPTunnel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
Word32
result <- Ptr DeviceIPTunnel -> IO Word32
nm_device_ip_tunnel_get_flow_label Ptr DeviceIPTunnel
device'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result
#if defined(ENABLE_OVERLOADING)
data DeviceIPTunnelGetFlowLabelMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsDeviceIPTunnel a) => O.OverloadedMethod DeviceIPTunnelGetFlowLabelMethodInfo a signature where
overloadedMethod = deviceIPTunnelGetFlowLabel
instance O.OverloadedMethodInfo DeviceIPTunnelGetFlowLabelMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceIPTunnel.deviceIPTunnelGetFlowLabel",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceIPTunnel.html#v:deviceIPTunnelGetFlowLabel"
})
#endif
foreign import ccall "nm_device_ip_tunnel_get_fwmark" nm_device_ip_tunnel_get_fwmark ::
Ptr DeviceIPTunnel ->
IO Word32
deviceIPTunnelGetFwmark ::
(B.CallStack.HasCallStack, MonadIO m, IsDeviceIPTunnel a) =>
a
-> m Word32
deviceIPTunnelGetFwmark :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDeviceIPTunnel a) =>
a -> m Word32
deviceIPTunnelGetFwmark a
device = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
Ptr DeviceIPTunnel
device' <- a -> IO (Ptr DeviceIPTunnel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
Word32
result <- Ptr DeviceIPTunnel -> IO Word32
nm_device_ip_tunnel_get_fwmark Ptr DeviceIPTunnel
device'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result
#if defined(ENABLE_OVERLOADING)
data DeviceIPTunnelGetFwmarkMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsDeviceIPTunnel a) => O.OverloadedMethod DeviceIPTunnelGetFwmarkMethodInfo a signature where
overloadedMethod = deviceIPTunnelGetFwmark
instance O.OverloadedMethodInfo DeviceIPTunnelGetFwmarkMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceIPTunnel.deviceIPTunnelGetFwmark",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceIPTunnel.html#v:deviceIPTunnelGetFwmark"
})
#endif
foreign import ccall "nm_device_ip_tunnel_get_input_key" nm_device_ip_tunnel_get_input_key ::
Ptr DeviceIPTunnel ->
IO CString
deviceIPTunnelGetInputKey ::
(B.CallStack.HasCallStack, MonadIO m, IsDeviceIPTunnel a) =>
a
-> m T.Text
deviceIPTunnelGetInputKey :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDeviceIPTunnel a) =>
a -> m Text
deviceIPTunnelGetInputKey a
device = 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 DeviceIPTunnel
device' <- a -> IO (Ptr DeviceIPTunnel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
CString
result <- Ptr DeviceIPTunnel -> IO CString
nm_device_ip_tunnel_get_input_key Ptr DeviceIPTunnel
device'
Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"deviceIPTunnelGetInputKey" CString
result
Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'
#if defined(ENABLE_OVERLOADING)
data DeviceIPTunnelGetInputKeyMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsDeviceIPTunnel a) => O.OverloadedMethod DeviceIPTunnelGetInputKeyMethodInfo a signature where
overloadedMethod = deviceIPTunnelGetInputKey
instance O.OverloadedMethodInfo DeviceIPTunnelGetInputKeyMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceIPTunnel.deviceIPTunnelGetInputKey",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceIPTunnel.html#v:deviceIPTunnelGetInputKey"
})
#endif
foreign import ccall "nm_device_ip_tunnel_get_local" nm_device_ip_tunnel_get_local ::
Ptr DeviceIPTunnel ->
IO CString
deviceIPTunnelGetLocal ::
(B.CallStack.HasCallStack, MonadIO m, IsDeviceIPTunnel a) =>
a
-> m T.Text
deviceIPTunnelGetLocal :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDeviceIPTunnel a) =>
a -> m Text
deviceIPTunnelGetLocal a
device = 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 DeviceIPTunnel
device' <- a -> IO (Ptr DeviceIPTunnel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
CString
result <- Ptr DeviceIPTunnel -> IO CString
nm_device_ip_tunnel_get_local Ptr DeviceIPTunnel
device'
Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"deviceIPTunnelGetLocal" CString
result
Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'
#if defined(ENABLE_OVERLOADING)
data DeviceIPTunnelGetLocalMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsDeviceIPTunnel a) => O.OverloadedMethod DeviceIPTunnelGetLocalMethodInfo a signature where
overloadedMethod = deviceIPTunnelGetLocal
instance O.OverloadedMethodInfo DeviceIPTunnelGetLocalMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceIPTunnel.deviceIPTunnelGetLocal",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceIPTunnel.html#v:deviceIPTunnelGetLocal"
})
#endif
foreign import ccall "nm_device_ip_tunnel_get_mode" nm_device_ip_tunnel_get_mode ::
Ptr DeviceIPTunnel ->
IO CUInt
deviceIPTunnelGetMode ::
(B.CallStack.HasCallStack, MonadIO m, IsDeviceIPTunnel a) =>
a
-> m NM.Enums.IPTunnelMode
deviceIPTunnelGetMode :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDeviceIPTunnel a) =>
a -> m IPTunnelMode
deviceIPTunnelGetMode a
device = IO IPTunnelMode -> m IPTunnelMode
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IPTunnelMode -> m IPTunnelMode)
-> IO IPTunnelMode -> m IPTunnelMode
forall a b. (a -> b) -> a -> b
$ do
Ptr DeviceIPTunnel
device' <- a -> IO (Ptr DeviceIPTunnel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
CUInt
result <- Ptr DeviceIPTunnel -> IO CUInt
nm_device_ip_tunnel_get_mode Ptr DeviceIPTunnel
device'
let result' :: IPTunnelMode
result' = (Int -> IPTunnelMode
forall a. Enum a => Int -> a
toEnum (Int -> IPTunnelMode) -> (CUInt -> Int) -> CUInt -> IPTunnelMode
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
device
IPTunnelMode -> IO IPTunnelMode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IPTunnelMode
result'
#if defined(ENABLE_OVERLOADING)
data DeviceIPTunnelGetModeMethodInfo
instance (signature ~ (m NM.Enums.IPTunnelMode), MonadIO m, IsDeviceIPTunnel a) => O.OverloadedMethod DeviceIPTunnelGetModeMethodInfo a signature where
overloadedMethod = deviceIPTunnelGetMode
instance O.OverloadedMethodInfo DeviceIPTunnelGetModeMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceIPTunnel.deviceIPTunnelGetMode",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceIPTunnel.html#v:deviceIPTunnelGetMode"
})
#endif
foreign import ccall "nm_device_ip_tunnel_get_output_key" nm_device_ip_tunnel_get_output_key ::
Ptr DeviceIPTunnel ->
IO CString
deviceIPTunnelGetOutputKey ::
(B.CallStack.HasCallStack, MonadIO m, IsDeviceIPTunnel a) =>
a
-> m T.Text
deviceIPTunnelGetOutputKey :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDeviceIPTunnel a) =>
a -> m Text
deviceIPTunnelGetOutputKey a
device = 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 DeviceIPTunnel
device' <- a -> IO (Ptr DeviceIPTunnel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
CString
result <- Ptr DeviceIPTunnel -> IO CString
nm_device_ip_tunnel_get_output_key Ptr DeviceIPTunnel
device'
Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"deviceIPTunnelGetOutputKey" CString
result
Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'
#if defined(ENABLE_OVERLOADING)
data DeviceIPTunnelGetOutputKeyMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsDeviceIPTunnel a) => O.OverloadedMethod DeviceIPTunnelGetOutputKeyMethodInfo a signature where
overloadedMethod = deviceIPTunnelGetOutputKey
instance O.OverloadedMethodInfo DeviceIPTunnelGetOutputKeyMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceIPTunnel.deviceIPTunnelGetOutputKey",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceIPTunnel.html#v:deviceIPTunnelGetOutputKey"
})
#endif
foreign import ccall "nm_device_ip_tunnel_get_parent" nm_device_ip_tunnel_get_parent ::
Ptr DeviceIPTunnel ->
IO (Ptr NM.Device.Device)
deviceIPTunnelGetParent ::
(B.CallStack.HasCallStack, MonadIO m, IsDeviceIPTunnel a) =>
a
-> m NM.Device.Device
deviceIPTunnelGetParent :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDeviceIPTunnel a) =>
a -> m Device
deviceIPTunnelGetParent a
device = 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 DeviceIPTunnel
device' <- a -> IO (Ptr DeviceIPTunnel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
Ptr Device
result <- Ptr DeviceIPTunnel -> IO (Ptr Device)
nm_device_ip_tunnel_get_parent Ptr DeviceIPTunnel
device'
Text -> Ptr Device -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"deviceIPTunnelGetParent" Ptr Device
result
Device
result' <- ((ManagedPtr Device -> Device) -> Ptr Device -> IO Device
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Device -> Device
NM.Device.Device) Ptr Device
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
Device -> IO Device
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Device
result'
#if defined(ENABLE_OVERLOADING)
data DeviceIPTunnelGetParentMethodInfo
instance (signature ~ (m NM.Device.Device), MonadIO m, IsDeviceIPTunnel a) => O.OverloadedMethod DeviceIPTunnelGetParentMethodInfo a signature where
overloadedMethod = deviceIPTunnelGetParent
instance O.OverloadedMethodInfo DeviceIPTunnelGetParentMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceIPTunnel.deviceIPTunnelGetParent",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceIPTunnel.html#v:deviceIPTunnelGetParent"
})
#endif
foreign import ccall "nm_device_ip_tunnel_get_path_mtu_discovery" nm_device_ip_tunnel_get_path_mtu_discovery ::
Ptr DeviceIPTunnel ->
IO CInt
deviceIPTunnelGetPathMtuDiscovery ::
(B.CallStack.HasCallStack, MonadIO m, IsDeviceIPTunnel a) =>
a
-> m Bool
deviceIPTunnelGetPathMtuDiscovery :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDeviceIPTunnel a) =>
a -> m Bool
deviceIPTunnelGetPathMtuDiscovery a
device = 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 DeviceIPTunnel
device' <- a -> IO (Ptr DeviceIPTunnel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
CInt
result <- Ptr DeviceIPTunnel -> IO CInt
nm_device_ip_tunnel_get_path_mtu_discovery Ptr DeviceIPTunnel
device'
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
device
Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data DeviceIPTunnelGetPathMtuDiscoveryMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsDeviceIPTunnel a) => O.OverloadedMethod DeviceIPTunnelGetPathMtuDiscoveryMethodInfo a signature where
overloadedMethod = deviceIPTunnelGetPathMtuDiscovery
instance O.OverloadedMethodInfo DeviceIPTunnelGetPathMtuDiscoveryMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceIPTunnel.deviceIPTunnelGetPathMtuDiscovery",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceIPTunnel.html#v:deviceIPTunnelGetPathMtuDiscovery"
})
#endif
foreign import ccall "nm_device_ip_tunnel_get_remote" nm_device_ip_tunnel_get_remote ::
Ptr DeviceIPTunnel ->
IO CString
deviceIPTunnelGetRemote ::
(B.CallStack.HasCallStack, MonadIO m, IsDeviceIPTunnel a) =>
a
-> m T.Text
deviceIPTunnelGetRemote :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDeviceIPTunnel a) =>
a -> m Text
deviceIPTunnelGetRemote a
device = 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 DeviceIPTunnel
device' <- a -> IO (Ptr DeviceIPTunnel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
CString
result <- Ptr DeviceIPTunnel -> IO CString
nm_device_ip_tunnel_get_remote Ptr DeviceIPTunnel
device'
Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"deviceIPTunnelGetRemote" CString
result
Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'
#if defined(ENABLE_OVERLOADING)
data DeviceIPTunnelGetRemoteMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsDeviceIPTunnel a) => O.OverloadedMethod DeviceIPTunnelGetRemoteMethodInfo a signature where
overloadedMethod = deviceIPTunnelGetRemote
instance O.OverloadedMethodInfo DeviceIPTunnelGetRemoteMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceIPTunnel.deviceIPTunnelGetRemote",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceIPTunnel.html#v:deviceIPTunnelGetRemote"
})
#endif
foreign import ccall "nm_device_ip_tunnel_get_tos" nm_device_ip_tunnel_get_tos ::
Ptr DeviceIPTunnel ->
IO Word8
deviceIPTunnelGetTos ::
(B.CallStack.HasCallStack, MonadIO m, IsDeviceIPTunnel a) =>
a
-> m Word8
deviceIPTunnelGetTos :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDeviceIPTunnel a) =>
a -> m Word8
deviceIPTunnelGetTos a
device = IO Word8 -> m Word8
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word8 -> m Word8) -> IO Word8 -> m Word8
forall a b. (a -> b) -> a -> b
$ do
Ptr DeviceIPTunnel
device' <- a -> IO (Ptr DeviceIPTunnel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
Word8
result <- Ptr DeviceIPTunnel -> IO Word8
nm_device_ip_tunnel_get_tos Ptr DeviceIPTunnel
device'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
Word8 -> IO Word8
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
result
#if defined(ENABLE_OVERLOADING)
data DeviceIPTunnelGetTosMethodInfo
instance (signature ~ (m Word8), MonadIO m, IsDeviceIPTunnel a) => O.OverloadedMethod DeviceIPTunnelGetTosMethodInfo a signature where
overloadedMethod = deviceIPTunnelGetTos
instance O.OverloadedMethodInfo DeviceIPTunnelGetTosMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceIPTunnel.deviceIPTunnelGetTos",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceIPTunnel.html#v:deviceIPTunnelGetTos"
})
#endif
foreign import ccall "nm_device_ip_tunnel_get_ttl" nm_device_ip_tunnel_get_ttl ::
Ptr DeviceIPTunnel ->
IO Word8
deviceIPTunnelGetTtl ::
(B.CallStack.HasCallStack, MonadIO m, IsDeviceIPTunnel a) =>
a
-> m Word8
deviceIPTunnelGetTtl :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDeviceIPTunnel a) =>
a -> m Word8
deviceIPTunnelGetTtl a
device = IO Word8 -> m Word8
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word8 -> m Word8) -> IO Word8 -> m Word8
forall a b. (a -> b) -> a -> b
$ do
Ptr DeviceIPTunnel
device' <- a -> IO (Ptr DeviceIPTunnel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
Word8
result <- Ptr DeviceIPTunnel -> IO Word8
nm_device_ip_tunnel_get_ttl Ptr DeviceIPTunnel
device'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
Word8 -> IO Word8
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
result
#if defined(ENABLE_OVERLOADING)
data DeviceIPTunnelGetTtlMethodInfo
instance (signature ~ (m Word8), MonadIO m, IsDeviceIPTunnel a) => O.OverloadedMethod DeviceIPTunnelGetTtlMethodInfo a signature where
overloadedMethod = deviceIPTunnelGetTtl
instance O.OverloadedMethodInfo DeviceIPTunnelGetTtlMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceIPTunnel.deviceIPTunnelGetTtl",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceIPTunnel.html#v:deviceIPTunnelGetTtl"
})
#endif