{-# LANGUAGE TypeApplications #-}
#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif
module GI.NM.Objects.DeviceMacsec
(
DeviceMacsec(..) ,
IsDeviceMacsec ,
toDeviceMacsec ,
#if defined(ENABLE_OVERLOADING)
ResolveDeviceMacsecMethod ,
#endif
#if defined(ENABLE_OVERLOADING)
DeviceMacsecGetCipherSuiteMethodInfo ,
#endif
deviceMacsecGetCipherSuite ,
#if defined(ENABLE_OVERLOADING)
DeviceMacsecGetEncodingSaMethodInfo ,
#endif
deviceMacsecGetEncodingSa ,
#if defined(ENABLE_OVERLOADING)
DeviceMacsecGetEncryptMethodInfo ,
#endif
deviceMacsecGetEncrypt ,
#if defined(ENABLE_OVERLOADING)
DeviceMacsecGetEsMethodInfo ,
#endif
deviceMacsecGetEs ,
#if defined(ENABLE_OVERLOADING)
DeviceMacsecGetIcvLengthMethodInfo ,
#endif
deviceMacsecGetIcvLength ,
#if defined(ENABLE_OVERLOADING)
DeviceMacsecGetIncludeSciMethodInfo ,
#endif
deviceMacsecGetIncludeSci ,
#if defined(ENABLE_OVERLOADING)
DeviceMacsecGetParentMethodInfo ,
#endif
deviceMacsecGetParent ,
#if defined(ENABLE_OVERLOADING)
DeviceMacsecGetProtectMethodInfo ,
#endif
deviceMacsecGetProtect ,
#if defined(ENABLE_OVERLOADING)
DeviceMacsecGetReplayProtectMethodInfo ,
#endif
deviceMacsecGetReplayProtect ,
#if defined(ENABLE_OVERLOADING)
DeviceMacsecGetScbMethodInfo ,
#endif
deviceMacsecGetScb ,
#if defined(ENABLE_OVERLOADING)
DeviceMacsecGetSciMethodInfo ,
#endif
deviceMacsecGetSci ,
#if defined(ENABLE_OVERLOADING)
DeviceMacsecGetValidationMethodInfo ,
#endif
deviceMacsecGetValidation ,
#if defined(ENABLE_OVERLOADING)
DeviceMacsecGetWindowMethodInfo ,
#endif
deviceMacsecGetWindow ,
#if defined(ENABLE_OVERLOADING)
DeviceMacsecCipherSuitePropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
deviceMacsecCipherSuite ,
#endif
getDeviceMacsecCipherSuite ,
#if defined(ENABLE_OVERLOADING)
DeviceMacsecEncodingSaPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
deviceMacsecEncodingSa ,
#endif
#if defined(ENABLE_OVERLOADING)
DeviceMacsecEncryptPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
deviceMacsecEncrypt ,
#endif
getDeviceMacsecEncrypt ,
#if defined(ENABLE_OVERLOADING)
DeviceMacsecEsPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
deviceMacsecEs ,
#endif
getDeviceMacsecEs ,
#if defined(ENABLE_OVERLOADING)
DeviceMacsecIcvLengthPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
deviceMacsecIcvLength ,
#endif
#if defined(ENABLE_OVERLOADING)
DeviceMacsecIncludeSciPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
deviceMacsecIncludeSci ,
#endif
getDeviceMacsecIncludeSci ,
#if defined(ENABLE_OVERLOADING)
DeviceMacsecParentPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
deviceMacsecParent ,
#endif
getDeviceMacsecParent ,
#if defined(ENABLE_OVERLOADING)
DeviceMacsecProtectPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
deviceMacsecProtect ,
#endif
getDeviceMacsecProtect ,
#if defined(ENABLE_OVERLOADING)
DeviceMacsecReplayProtectPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
deviceMacsecReplayProtect ,
#endif
getDeviceMacsecReplayProtect ,
#if defined(ENABLE_OVERLOADING)
DeviceMacsecScbPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
deviceMacsecScb ,
#endif
getDeviceMacsecScb ,
#if defined(ENABLE_OVERLOADING)
DeviceMacsecSciPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
deviceMacsecSci ,
#endif
getDeviceMacsecSci ,
#if defined(ENABLE_OVERLOADING)
DeviceMacsecValidationPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
deviceMacsecValidation ,
#endif
getDeviceMacsecValidation ,
#if defined(ENABLE_OVERLOADING)
DeviceMacsecWindowPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
deviceMacsecWindow ,
#endif
getDeviceMacsecWindow ,
) 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.Objects.Device as NM.Device
import {-# SOURCE #-} qualified GI.NM.Objects.Object as NM.Object
#endif
newtype DeviceMacsec = DeviceMacsec (SP.ManagedPtr DeviceMacsec)
deriving (DeviceMacsec -> DeviceMacsec -> Bool
(DeviceMacsec -> DeviceMacsec -> Bool)
-> (DeviceMacsec -> DeviceMacsec -> Bool) -> Eq DeviceMacsec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeviceMacsec -> DeviceMacsec -> Bool
== :: DeviceMacsec -> DeviceMacsec -> Bool
$c/= :: DeviceMacsec -> DeviceMacsec -> Bool
/= :: DeviceMacsec -> DeviceMacsec -> Bool
Eq)
instance SP.ManagedPtrNewtype DeviceMacsec where
toManagedPtr :: DeviceMacsec -> ManagedPtr DeviceMacsec
toManagedPtr (DeviceMacsec ManagedPtr DeviceMacsec
p) = ManagedPtr DeviceMacsec
p
foreign import ccall "nm_device_macsec_get_type"
c_nm_device_macsec_get_type :: IO B.Types.GType
instance B.Types.TypedObject DeviceMacsec where
glibType :: IO GType
glibType = IO GType
c_nm_device_macsec_get_type
instance B.Types.GObject DeviceMacsec
class (SP.GObject o, O.IsDescendantOf DeviceMacsec o) => IsDeviceMacsec o
instance (SP.GObject o, O.IsDescendantOf DeviceMacsec o) => IsDeviceMacsec o
instance O.HasParentTypes DeviceMacsec
type instance O.ParentTypes DeviceMacsec = '[NM.Device.Device, NM.Object.Object, GObject.Object.Object]
toDeviceMacsec :: (MIO.MonadIO m, IsDeviceMacsec o) => o -> m DeviceMacsec
toDeviceMacsec :: forall (m :: * -> *) o.
(MonadIO m, IsDeviceMacsec o) =>
o -> m DeviceMacsec
toDeviceMacsec = IO DeviceMacsec -> m DeviceMacsec
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO DeviceMacsec -> m DeviceMacsec)
-> (o -> IO DeviceMacsec) -> o -> m DeviceMacsec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr DeviceMacsec -> DeviceMacsec) -> o -> IO DeviceMacsec
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr DeviceMacsec -> DeviceMacsec
DeviceMacsec
instance B.GValue.IsGValue (Maybe DeviceMacsec) where
gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_nm_device_macsec_get_type
gvalueSet_ :: Ptr GValue -> Maybe DeviceMacsec -> IO ()
gvalueSet_ Ptr GValue
gv Maybe DeviceMacsec
P.Nothing = Ptr GValue -> Ptr DeviceMacsec -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr DeviceMacsec
forall a. Ptr a
FP.nullPtr :: FP.Ptr DeviceMacsec)
gvalueSet_ Ptr GValue
gv (P.Just DeviceMacsec
obj) = DeviceMacsec -> (Ptr DeviceMacsec -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr DeviceMacsec
obj (Ptr GValue -> Ptr DeviceMacsec -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
gvalueGet_ :: Ptr GValue -> IO (Maybe DeviceMacsec)
gvalueGet_ Ptr GValue
gv = do
Ptr DeviceMacsec
ptr <- Ptr GValue -> IO (Ptr DeviceMacsec)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr DeviceMacsec)
if Ptr DeviceMacsec
ptr Ptr DeviceMacsec -> Ptr DeviceMacsec -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr DeviceMacsec
forall a. Ptr a
FP.nullPtr
then DeviceMacsec -> Maybe DeviceMacsec
forall a. a -> Maybe a
P.Just (DeviceMacsec -> Maybe DeviceMacsec)
-> IO DeviceMacsec -> IO (Maybe DeviceMacsec)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr DeviceMacsec -> DeviceMacsec)
-> Ptr DeviceMacsec -> IO DeviceMacsec
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr DeviceMacsec -> DeviceMacsec
DeviceMacsec Ptr DeviceMacsec
ptr
else Maybe DeviceMacsec -> IO (Maybe DeviceMacsec)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DeviceMacsec
forall a. Maybe a
P.Nothing
#if defined(ENABLE_OVERLOADING)
type family ResolveDeviceMacsecMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
ResolveDeviceMacsecMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
ResolveDeviceMacsecMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
ResolveDeviceMacsecMethod "connectionCompatible" o = NM.Device.DeviceConnectionCompatibleMethodInfo
ResolveDeviceMacsecMethod "connectionValid" o = NM.Device.DeviceConnectionValidMethodInfo
ResolveDeviceMacsecMethod "delete" o = NM.Device.DeviceDeleteMethodInfo
ResolveDeviceMacsecMethod "deleteAsync" o = NM.Device.DeviceDeleteAsyncMethodInfo
ResolveDeviceMacsecMethod "deleteFinish" o = NM.Device.DeviceDeleteFinishMethodInfo
ResolveDeviceMacsecMethod "disconnect" o = NM.Device.DeviceDisconnectMethodInfo
ResolveDeviceMacsecMethod "disconnectAsync" o = NM.Device.DeviceDisconnectAsyncMethodInfo
ResolveDeviceMacsecMethod "disconnectFinish" o = NM.Device.DeviceDisconnectFinishMethodInfo
ResolveDeviceMacsecMethod "filterConnections" o = NM.Device.DeviceFilterConnectionsMethodInfo
ResolveDeviceMacsecMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
ResolveDeviceMacsecMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
ResolveDeviceMacsecMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
ResolveDeviceMacsecMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
ResolveDeviceMacsecMethod "isReal" o = NM.Device.DeviceIsRealMethodInfo
ResolveDeviceMacsecMethod "isSoftware" o = NM.Device.DeviceIsSoftwareMethodInfo
ResolveDeviceMacsecMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
ResolveDeviceMacsecMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
ResolveDeviceMacsecMethod "reapply" o = NM.Device.DeviceReapplyMethodInfo
ResolveDeviceMacsecMethod "reapplyAsync" o = NM.Device.DeviceReapplyAsyncMethodInfo
ResolveDeviceMacsecMethod "reapplyFinish" o = NM.Device.DeviceReapplyFinishMethodInfo
ResolveDeviceMacsecMethod "ref" o = GObject.Object.ObjectRefMethodInfo
ResolveDeviceMacsecMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
ResolveDeviceMacsecMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
ResolveDeviceMacsecMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
ResolveDeviceMacsecMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
ResolveDeviceMacsecMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
ResolveDeviceMacsecMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
ResolveDeviceMacsecMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
ResolveDeviceMacsecMethod "getActiveConnection" o = NM.Device.DeviceGetActiveConnectionMethodInfo
ResolveDeviceMacsecMethod "getAppliedConnection" o = NM.Device.DeviceGetAppliedConnectionMethodInfo
ResolveDeviceMacsecMethod "getAppliedConnectionAsync" o = NM.Device.DeviceGetAppliedConnectionAsyncMethodInfo
ResolveDeviceMacsecMethod "getAppliedConnectionFinish" o = NM.Device.DeviceGetAppliedConnectionFinishMethodInfo
ResolveDeviceMacsecMethod "getAutoconnect" o = NM.Device.DeviceGetAutoconnectMethodInfo
ResolveDeviceMacsecMethod "getAvailableConnections" o = NM.Device.DeviceGetAvailableConnectionsMethodInfo
ResolveDeviceMacsecMethod "getCapabilities" o = NM.Device.DeviceGetCapabilitiesMethodInfo
ResolveDeviceMacsecMethod "getCipherSuite" o = DeviceMacsecGetCipherSuiteMethodInfo
ResolveDeviceMacsecMethod "getClient" o = NM.Object.ObjectGetClientMethodInfo
ResolveDeviceMacsecMethod "getConnectivity" o = NM.Device.DeviceGetConnectivityMethodInfo
ResolveDeviceMacsecMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
ResolveDeviceMacsecMethod "getDescription" o = NM.Device.DeviceGetDescriptionMethodInfo
ResolveDeviceMacsecMethod "getDeviceType" o = NM.Device.DeviceGetDeviceTypeMethodInfo
ResolveDeviceMacsecMethod "getDhcp4Config" o = NM.Device.DeviceGetDhcp4ConfigMethodInfo
ResolveDeviceMacsecMethod "getDhcp6Config" o = NM.Device.DeviceGetDhcp6ConfigMethodInfo
ResolveDeviceMacsecMethod "getDriver" o = NM.Device.DeviceGetDriverMethodInfo
ResolveDeviceMacsecMethod "getDriverVersion" o = NM.Device.DeviceGetDriverVersionMethodInfo
ResolveDeviceMacsecMethod "getEncodingSa" o = DeviceMacsecGetEncodingSaMethodInfo
ResolveDeviceMacsecMethod "getEncrypt" o = DeviceMacsecGetEncryptMethodInfo
ResolveDeviceMacsecMethod "getEs" o = DeviceMacsecGetEsMethodInfo
ResolveDeviceMacsecMethod "getFirmwareMissing" o = NM.Device.DeviceGetFirmwareMissingMethodInfo
ResolveDeviceMacsecMethod "getFirmwareVersion" o = NM.Device.DeviceGetFirmwareVersionMethodInfo
ResolveDeviceMacsecMethod "getHwAddress" o = NM.Device.DeviceGetHwAddressMethodInfo
ResolveDeviceMacsecMethod "getIcvLength" o = DeviceMacsecGetIcvLengthMethodInfo
ResolveDeviceMacsecMethod "getIface" o = NM.Device.DeviceGetIfaceMethodInfo
ResolveDeviceMacsecMethod "getIncludeSci" o = DeviceMacsecGetIncludeSciMethodInfo
ResolveDeviceMacsecMethod "getInterfaceFlags" o = NM.Device.DeviceGetInterfaceFlagsMethodInfo
ResolveDeviceMacsecMethod "getIp4Config" o = NM.Device.DeviceGetIp4ConfigMethodInfo
ResolveDeviceMacsecMethod "getIp6Config" o = NM.Device.DeviceGetIp6ConfigMethodInfo
ResolveDeviceMacsecMethod "getIpIface" o = NM.Device.DeviceGetIpIfaceMethodInfo
ResolveDeviceMacsecMethod "getLldpNeighbors" o = NM.Device.DeviceGetLldpNeighborsMethodInfo
ResolveDeviceMacsecMethod "getManaged" o = NM.Device.DeviceGetManagedMethodInfo
ResolveDeviceMacsecMethod "getMetered" o = NM.Device.DeviceGetMeteredMethodInfo
ResolveDeviceMacsecMethod "getMtu" o = NM.Device.DeviceGetMtuMethodInfo
ResolveDeviceMacsecMethod "getNmPluginMissing" o = NM.Device.DeviceGetNmPluginMissingMethodInfo
ResolveDeviceMacsecMethod "getParent" o = DeviceMacsecGetParentMethodInfo
ResolveDeviceMacsecMethod "getPath" o = NM.Device.DeviceGetPathMethodInfo
ResolveDeviceMacsecMethod "getPhysicalPortId" o = NM.Device.DeviceGetPhysicalPortIdMethodInfo
ResolveDeviceMacsecMethod "getPorts" o = NM.Device.DeviceGetPortsMethodInfo
ResolveDeviceMacsecMethod "getProduct" o = NM.Device.DeviceGetProductMethodInfo
ResolveDeviceMacsecMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
ResolveDeviceMacsecMethod "getProtect" o = DeviceMacsecGetProtectMethodInfo
ResolveDeviceMacsecMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
ResolveDeviceMacsecMethod "getReplayProtect" o = DeviceMacsecGetReplayProtectMethodInfo
ResolveDeviceMacsecMethod "getScb" o = DeviceMacsecGetScbMethodInfo
ResolveDeviceMacsecMethod "getSci" o = DeviceMacsecGetSciMethodInfo
ResolveDeviceMacsecMethod "getSettingType" o = NM.Device.DeviceGetSettingTypeMethodInfo
ResolveDeviceMacsecMethod "getState" o = NM.Device.DeviceGetStateMethodInfo
ResolveDeviceMacsecMethod "getStateReason" o = NM.Device.DeviceGetStateReasonMethodInfo
ResolveDeviceMacsecMethod "getTypeDescription" o = NM.Device.DeviceGetTypeDescriptionMethodInfo
ResolveDeviceMacsecMethod "getUdi" o = NM.Device.DeviceGetUdiMethodInfo
ResolveDeviceMacsecMethod "getValidation" o = DeviceMacsecGetValidationMethodInfo
ResolveDeviceMacsecMethod "getVendor" o = NM.Device.DeviceGetVendorMethodInfo
ResolveDeviceMacsecMethod "getWindow" o = DeviceMacsecGetWindowMethodInfo
ResolveDeviceMacsecMethod "setAutoconnect" o = NM.Device.DeviceSetAutoconnectMethodInfo
ResolveDeviceMacsecMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
ResolveDeviceMacsecMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
ResolveDeviceMacsecMethod "setManaged" o = NM.Device.DeviceSetManagedMethodInfo
ResolveDeviceMacsecMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
ResolveDeviceMacsecMethod l o = O.MethodResolutionFailed l o
instance (info ~ ResolveDeviceMacsecMethod t DeviceMacsec, O.OverloadedMethod info DeviceMacsec p) => OL.IsLabel t (DeviceMacsec -> 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 ~ ResolveDeviceMacsecMethod t DeviceMacsec, O.OverloadedMethod info DeviceMacsec p, R.HasField t DeviceMacsec p) => R.HasField t DeviceMacsec p where
getField = O.overloadedMethod @info
#endif
instance (info ~ ResolveDeviceMacsecMethod t DeviceMacsec, O.OverloadedMethodInfo info DeviceMacsec) => OL.IsLabel t (O.MethodProxy info DeviceMacsec) where
#if MIN_VERSION_base(4,10,0)
fromLabel = O.MethodProxy
#else
fromLabel _ = O.MethodProxy
#endif
#endif
getDeviceMacsecCipherSuite :: (MonadIO m, IsDeviceMacsec o) => o -> m Word64
getDeviceMacsecCipherSuite :: forall (m :: * -> *) o.
(MonadIO m, IsDeviceMacsec o) =>
o -> m Word64
getDeviceMacsecCipherSuite o
obj = IO Word64 -> m Word64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word64
forall a. GObject a => a -> String -> IO Word64
B.Properties.getObjectPropertyUInt64 o
obj String
"cipher-suite"
#if defined(ENABLE_OVERLOADING)
data DeviceMacsecCipherSuitePropertyInfo
instance AttrInfo DeviceMacsecCipherSuitePropertyInfo where
type AttrAllowedOps DeviceMacsecCipherSuitePropertyInfo = '[ 'AttrGet]
type AttrBaseTypeConstraint DeviceMacsecCipherSuitePropertyInfo = IsDeviceMacsec
type AttrSetTypeConstraint DeviceMacsecCipherSuitePropertyInfo = (~) ()
type AttrTransferTypeConstraint DeviceMacsecCipherSuitePropertyInfo = (~) ()
type AttrTransferType DeviceMacsecCipherSuitePropertyInfo = ()
type AttrGetType DeviceMacsecCipherSuitePropertyInfo = Word64
type AttrLabel DeviceMacsecCipherSuitePropertyInfo = "cipher-suite"
type AttrOrigin DeviceMacsecCipherSuitePropertyInfo = DeviceMacsec
attrGet = getDeviceMacsecCipherSuite
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceMacsec.cipherSuite"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceMacsec.html#g:attr:cipherSuite"
})
#endif
#if defined(ENABLE_OVERLOADING)
data DeviceMacsecEncodingSaPropertyInfo
instance AttrInfo DeviceMacsecEncodingSaPropertyInfo where
type AttrAllowedOps DeviceMacsecEncodingSaPropertyInfo = '[]
type AttrSetTypeConstraint DeviceMacsecEncodingSaPropertyInfo = (~) ()
type AttrTransferTypeConstraint DeviceMacsecEncodingSaPropertyInfo = (~) ()
type AttrTransferType DeviceMacsecEncodingSaPropertyInfo = ()
type AttrBaseTypeConstraint DeviceMacsecEncodingSaPropertyInfo = (~) ()
type AttrGetType DeviceMacsecEncodingSaPropertyInfo = ()
type AttrLabel DeviceMacsecEncodingSaPropertyInfo = ""
type AttrOrigin DeviceMacsecEncodingSaPropertyInfo = DeviceMacsec
attrGet = undefined
attrSet = undefined
attrConstruct = undefined
attrClear = undefined
attrTransfer = undefined
#endif
getDeviceMacsecEncrypt :: (MonadIO m, IsDeviceMacsec o) => o -> m Bool
getDeviceMacsecEncrypt :: forall (m :: * -> *) o.
(MonadIO m, IsDeviceMacsec o) =>
o -> m Bool
getDeviceMacsecEncrypt 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
"encrypt"
#if defined(ENABLE_OVERLOADING)
data DeviceMacsecEncryptPropertyInfo
instance AttrInfo DeviceMacsecEncryptPropertyInfo where
type AttrAllowedOps DeviceMacsecEncryptPropertyInfo = '[ 'AttrGet]
type AttrBaseTypeConstraint DeviceMacsecEncryptPropertyInfo = IsDeviceMacsec
type AttrSetTypeConstraint DeviceMacsecEncryptPropertyInfo = (~) ()
type AttrTransferTypeConstraint DeviceMacsecEncryptPropertyInfo = (~) ()
type AttrTransferType DeviceMacsecEncryptPropertyInfo = ()
type AttrGetType DeviceMacsecEncryptPropertyInfo = Bool
type AttrLabel DeviceMacsecEncryptPropertyInfo = "encrypt"
type AttrOrigin DeviceMacsecEncryptPropertyInfo = DeviceMacsec
attrGet = getDeviceMacsecEncrypt
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceMacsec.encrypt"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceMacsec.html#g:attr:encrypt"
})
#endif
getDeviceMacsecEs :: (MonadIO m, IsDeviceMacsec o) => o -> m Bool
getDeviceMacsecEs :: forall (m :: * -> *) o.
(MonadIO m, IsDeviceMacsec o) =>
o -> m Bool
getDeviceMacsecEs 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
"es"
#if defined(ENABLE_OVERLOADING)
data DeviceMacsecEsPropertyInfo
instance AttrInfo DeviceMacsecEsPropertyInfo where
type AttrAllowedOps DeviceMacsecEsPropertyInfo = '[ 'AttrGet]
type AttrBaseTypeConstraint DeviceMacsecEsPropertyInfo = IsDeviceMacsec
type AttrSetTypeConstraint DeviceMacsecEsPropertyInfo = (~) ()
type AttrTransferTypeConstraint DeviceMacsecEsPropertyInfo = (~) ()
type AttrTransferType DeviceMacsecEsPropertyInfo = ()
type AttrGetType DeviceMacsecEsPropertyInfo = Bool
type AttrLabel DeviceMacsecEsPropertyInfo = "es"
type AttrOrigin DeviceMacsecEsPropertyInfo = DeviceMacsec
attrGet = getDeviceMacsecEs
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceMacsec.es"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceMacsec.html#g:attr:es"
})
#endif
#if defined(ENABLE_OVERLOADING)
data DeviceMacsecIcvLengthPropertyInfo
instance AttrInfo DeviceMacsecIcvLengthPropertyInfo where
type AttrAllowedOps DeviceMacsecIcvLengthPropertyInfo = '[]
type AttrSetTypeConstraint DeviceMacsecIcvLengthPropertyInfo = (~) ()
type AttrTransferTypeConstraint DeviceMacsecIcvLengthPropertyInfo = (~) ()
type AttrTransferType DeviceMacsecIcvLengthPropertyInfo = ()
type AttrBaseTypeConstraint DeviceMacsecIcvLengthPropertyInfo = (~) ()
type AttrGetType DeviceMacsecIcvLengthPropertyInfo = ()
type AttrLabel DeviceMacsecIcvLengthPropertyInfo = ""
type AttrOrigin DeviceMacsecIcvLengthPropertyInfo = DeviceMacsec
attrGet = undefined
attrSet = undefined
attrConstruct = undefined
attrClear = undefined
attrTransfer = undefined
#endif
getDeviceMacsecIncludeSci :: (MonadIO m, IsDeviceMacsec o) => o -> m Bool
getDeviceMacsecIncludeSci :: forall (m :: * -> *) o.
(MonadIO m, IsDeviceMacsec o) =>
o -> m Bool
getDeviceMacsecIncludeSci 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
"include-sci"
#if defined(ENABLE_OVERLOADING)
data DeviceMacsecIncludeSciPropertyInfo
instance AttrInfo DeviceMacsecIncludeSciPropertyInfo where
type AttrAllowedOps DeviceMacsecIncludeSciPropertyInfo = '[ 'AttrGet]
type AttrBaseTypeConstraint DeviceMacsecIncludeSciPropertyInfo = IsDeviceMacsec
type AttrSetTypeConstraint DeviceMacsecIncludeSciPropertyInfo = (~) ()
type AttrTransferTypeConstraint DeviceMacsecIncludeSciPropertyInfo = (~) ()
type AttrTransferType DeviceMacsecIncludeSciPropertyInfo = ()
type AttrGetType DeviceMacsecIncludeSciPropertyInfo = Bool
type AttrLabel DeviceMacsecIncludeSciPropertyInfo = "include-sci"
type AttrOrigin DeviceMacsecIncludeSciPropertyInfo = DeviceMacsec
attrGet = getDeviceMacsecIncludeSci
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceMacsec.includeSci"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceMacsec.html#g:attr:includeSci"
})
#endif
getDeviceMacsecParent :: (MonadIO m, IsDeviceMacsec o) => o -> m NM.Device.Device
getDeviceMacsecParent :: forall (m :: * -> *) o.
(MonadIO m, IsDeviceMacsec o) =>
o -> m Device
getDeviceMacsecParent 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
"getDeviceMacsecParent" (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 DeviceMacsecParentPropertyInfo
instance AttrInfo DeviceMacsecParentPropertyInfo where
type AttrAllowedOps DeviceMacsecParentPropertyInfo = '[ 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint DeviceMacsecParentPropertyInfo = IsDeviceMacsec
type AttrSetTypeConstraint DeviceMacsecParentPropertyInfo = (~) ()
type AttrTransferTypeConstraint DeviceMacsecParentPropertyInfo = (~) ()
type AttrTransferType DeviceMacsecParentPropertyInfo = ()
type AttrGetType DeviceMacsecParentPropertyInfo = NM.Device.Device
type AttrLabel DeviceMacsecParentPropertyInfo = "parent"
type AttrOrigin DeviceMacsecParentPropertyInfo = DeviceMacsec
attrGet = getDeviceMacsecParent
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceMacsec.parent"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceMacsec.html#g:attr:parent"
})
#endif
getDeviceMacsecProtect :: (MonadIO m, IsDeviceMacsec o) => o -> m Bool
getDeviceMacsecProtect :: forall (m :: * -> *) o.
(MonadIO m, IsDeviceMacsec o) =>
o -> m Bool
getDeviceMacsecProtect 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
"protect"
#if defined(ENABLE_OVERLOADING)
data DeviceMacsecProtectPropertyInfo
instance AttrInfo DeviceMacsecProtectPropertyInfo where
type AttrAllowedOps DeviceMacsecProtectPropertyInfo = '[ 'AttrGet]
type AttrBaseTypeConstraint DeviceMacsecProtectPropertyInfo = IsDeviceMacsec
type AttrSetTypeConstraint DeviceMacsecProtectPropertyInfo = (~) ()
type AttrTransferTypeConstraint DeviceMacsecProtectPropertyInfo = (~) ()
type AttrTransferType DeviceMacsecProtectPropertyInfo = ()
type AttrGetType DeviceMacsecProtectPropertyInfo = Bool
type AttrLabel DeviceMacsecProtectPropertyInfo = "protect"
type AttrOrigin DeviceMacsecProtectPropertyInfo = DeviceMacsec
attrGet = getDeviceMacsecProtect
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceMacsec.protect"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceMacsec.html#g:attr:protect"
})
#endif
getDeviceMacsecReplayProtect :: (MonadIO m, IsDeviceMacsec o) => o -> m Bool
getDeviceMacsecReplayProtect :: forall (m :: * -> *) o.
(MonadIO m, IsDeviceMacsec o) =>
o -> m Bool
getDeviceMacsecReplayProtect 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
"replay-protect"
#if defined(ENABLE_OVERLOADING)
data DeviceMacsecReplayProtectPropertyInfo
instance AttrInfo DeviceMacsecReplayProtectPropertyInfo where
type AttrAllowedOps DeviceMacsecReplayProtectPropertyInfo = '[ 'AttrGet]
type AttrBaseTypeConstraint DeviceMacsecReplayProtectPropertyInfo = IsDeviceMacsec
type AttrSetTypeConstraint DeviceMacsecReplayProtectPropertyInfo = (~) ()
type AttrTransferTypeConstraint DeviceMacsecReplayProtectPropertyInfo = (~) ()
type AttrTransferType DeviceMacsecReplayProtectPropertyInfo = ()
type AttrGetType DeviceMacsecReplayProtectPropertyInfo = Bool
type AttrLabel DeviceMacsecReplayProtectPropertyInfo = "replay-protect"
type AttrOrigin DeviceMacsecReplayProtectPropertyInfo = DeviceMacsec
attrGet = getDeviceMacsecReplayProtect
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceMacsec.replayProtect"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceMacsec.html#g:attr:replayProtect"
})
#endif
getDeviceMacsecScb :: (MonadIO m, IsDeviceMacsec o) => o -> m Bool
getDeviceMacsecScb :: forall (m :: * -> *) o.
(MonadIO m, IsDeviceMacsec o) =>
o -> m Bool
getDeviceMacsecScb 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
"scb"
#if defined(ENABLE_OVERLOADING)
data DeviceMacsecScbPropertyInfo
instance AttrInfo DeviceMacsecScbPropertyInfo where
type AttrAllowedOps DeviceMacsecScbPropertyInfo = '[ 'AttrGet]
type AttrBaseTypeConstraint DeviceMacsecScbPropertyInfo = IsDeviceMacsec
type AttrSetTypeConstraint DeviceMacsecScbPropertyInfo = (~) ()
type AttrTransferTypeConstraint DeviceMacsecScbPropertyInfo = (~) ()
type AttrTransferType DeviceMacsecScbPropertyInfo = ()
type AttrGetType DeviceMacsecScbPropertyInfo = Bool
type AttrLabel DeviceMacsecScbPropertyInfo = "scb"
type AttrOrigin DeviceMacsecScbPropertyInfo = DeviceMacsec
attrGet = getDeviceMacsecScb
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceMacsec.scb"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceMacsec.html#g:attr:scb"
})
#endif
getDeviceMacsecSci :: (MonadIO m, IsDeviceMacsec o) => o -> m Word64
getDeviceMacsecSci :: forall (m :: * -> *) o.
(MonadIO m, IsDeviceMacsec o) =>
o -> m Word64
getDeviceMacsecSci o
obj = IO Word64 -> m Word64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word64
forall a. GObject a => a -> String -> IO Word64
B.Properties.getObjectPropertyUInt64 o
obj String
"sci"
#if defined(ENABLE_OVERLOADING)
data DeviceMacsecSciPropertyInfo
instance AttrInfo DeviceMacsecSciPropertyInfo where
type AttrAllowedOps DeviceMacsecSciPropertyInfo = '[ 'AttrGet]
type AttrBaseTypeConstraint DeviceMacsecSciPropertyInfo = IsDeviceMacsec
type AttrSetTypeConstraint DeviceMacsecSciPropertyInfo = (~) ()
type AttrTransferTypeConstraint DeviceMacsecSciPropertyInfo = (~) ()
type AttrTransferType DeviceMacsecSciPropertyInfo = ()
type AttrGetType DeviceMacsecSciPropertyInfo = Word64
type AttrLabel DeviceMacsecSciPropertyInfo = "sci"
type AttrOrigin DeviceMacsecSciPropertyInfo = DeviceMacsec
attrGet = getDeviceMacsecSci
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceMacsec.sci"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceMacsec.html#g:attr:sci"
})
#endif
getDeviceMacsecValidation :: (MonadIO m, IsDeviceMacsec o) => o -> m T.Text
getDeviceMacsecValidation :: forall (m :: * -> *) o.
(MonadIO m, IsDeviceMacsec o) =>
o -> m Text
getDeviceMacsecValidation 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
"getDeviceMacsecValidation" (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
"validation"
#if defined(ENABLE_OVERLOADING)
data DeviceMacsecValidationPropertyInfo
instance AttrInfo DeviceMacsecValidationPropertyInfo where
type AttrAllowedOps DeviceMacsecValidationPropertyInfo = '[ 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint DeviceMacsecValidationPropertyInfo = IsDeviceMacsec
type AttrSetTypeConstraint DeviceMacsecValidationPropertyInfo = (~) ()
type AttrTransferTypeConstraint DeviceMacsecValidationPropertyInfo = (~) ()
type AttrTransferType DeviceMacsecValidationPropertyInfo = ()
type AttrGetType DeviceMacsecValidationPropertyInfo = T.Text
type AttrLabel DeviceMacsecValidationPropertyInfo = "validation"
type AttrOrigin DeviceMacsecValidationPropertyInfo = DeviceMacsec
attrGet = getDeviceMacsecValidation
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceMacsec.validation"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceMacsec.html#g:attr:validation"
})
#endif
getDeviceMacsecWindow :: (MonadIO m, IsDeviceMacsec o) => o -> m Word32
getDeviceMacsecWindow :: forall (m :: * -> *) o.
(MonadIO m, IsDeviceMacsec o) =>
o -> m Word32
getDeviceMacsecWindow 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
"window"
#if defined(ENABLE_OVERLOADING)
data DeviceMacsecWindowPropertyInfo
instance AttrInfo DeviceMacsecWindowPropertyInfo where
type AttrAllowedOps DeviceMacsecWindowPropertyInfo = '[ 'AttrGet]
type AttrBaseTypeConstraint DeviceMacsecWindowPropertyInfo = IsDeviceMacsec
type AttrSetTypeConstraint DeviceMacsecWindowPropertyInfo = (~) ()
type AttrTransferTypeConstraint DeviceMacsecWindowPropertyInfo = (~) ()
type AttrTransferType DeviceMacsecWindowPropertyInfo = ()
type AttrGetType DeviceMacsecWindowPropertyInfo = Word32
type AttrLabel DeviceMacsecWindowPropertyInfo = "window"
type AttrOrigin DeviceMacsecWindowPropertyInfo = DeviceMacsec
attrGet = getDeviceMacsecWindow
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceMacsec.window"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceMacsec.html#g:attr:window"
})
#endif
#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList DeviceMacsec
type instance O.AttributeList DeviceMacsec = DeviceMacsecAttributeList
type DeviceMacsecAttributeList = ('[ '("activeConnection", NM.Device.DeviceActiveConnectionPropertyInfo), '("autoconnect", NM.Device.DeviceAutoconnectPropertyInfo), '("availableConnections", NM.Device.DeviceAvailableConnectionsPropertyInfo), '("capabilities", NM.Device.DeviceCapabilitiesPropertyInfo), '("cipherSuite", DeviceMacsecCipherSuitePropertyInfo), '("client", NM.Object.ObjectClientPropertyInfo), '("deviceType", NM.Device.DeviceDeviceTypePropertyInfo), '("dhcp4Config", NM.Device.DeviceDhcp4ConfigPropertyInfo), '("dhcp6Config", NM.Device.DeviceDhcp6ConfigPropertyInfo), '("driver", NM.Device.DeviceDriverPropertyInfo), '("driverVersion", NM.Device.DeviceDriverVersionPropertyInfo), '("encodingSa", DeviceMacsecEncodingSaPropertyInfo), '("encrypt", DeviceMacsecEncryptPropertyInfo), '("es", DeviceMacsecEsPropertyInfo), '("firmwareMissing", NM.Device.DeviceFirmwareMissingPropertyInfo), '("firmwareVersion", NM.Device.DeviceFirmwareVersionPropertyInfo), '("hwAddress", NM.Device.DeviceHwAddressPropertyInfo), '("icvLength", DeviceMacsecIcvLengthPropertyInfo), '("includeSci", DeviceMacsecIncludeSciPropertyInfo), '("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), '("managed", NM.Device.DeviceManagedPropertyInfo), '("metered", NM.Device.DeviceMeteredPropertyInfo), '("mtu", NM.Device.DeviceMtuPropertyInfo), '("nmPluginMissing", NM.Device.DeviceNmPluginMissingPropertyInfo), '("parent", DeviceMacsecParentPropertyInfo), '("path", NM.Device.DevicePathPropertyInfo), '("physicalPortId", NM.Device.DevicePhysicalPortIdPropertyInfo), '("ports", NM.Device.DevicePortsPropertyInfo), '("product", NM.Device.DeviceProductPropertyInfo), '("protect", DeviceMacsecProtectPropertyInfo), '("real", NM.Device.DeviceRealPropertyInfo), '("replayProtect", DeviceMacsecReplayProtectPropertyInfo), '("scb", DeviceMacsecScbPropertyInfo), '("sci", DeviceMacsecSciPropertyInfo), '("state", NM.Device.DeviceStatePropertyInfo), '("stateReason", NM.Device.DeviceStateReasonPropertyInfo), '("udi", NM.Device.DeviceUdiPropertyInfo), '("validation", DeviceMacsecValidationPropertyInfo), '("vendor", NM.Device.DeviceVendorPropertyInfo), '("window", DeviceMacsecWindowPropertyInfo)] :: [(Symbol, DK.Type)])
#endif
#if defined(ENABLE_OVERLOADING)
deviceMacsecCipherSuite :: AttrLabelProxy "cipherSuite"
deviceMacsecCipherSuite = AttrLabelProxy
deviceMacsecEncodingSa :: AttrLabelProxy "encodingSa"
deviceMacsecEncodingSa = AttrLabelProxy
deviceMacsecEncrypt :: AttrLabelProxy "encrypt"
deviceMacsecEncrypt = AttrLabelProxy
deviceMacsecEs :: AttrLabelProxy "es"
deviceMacsecEs = AttrLabelProxy
deviceMacsecIcvLength :: AttrLabelProxy "icvLength"
deviceMacsecIcvLength = AttrLabelProxy
deviceMacsecIncludeSci :: AttrLabelProxy "includeSci"
deviceMacsecIncludeSci = AttrLabelProxy
deviceMacsecParent :: AttrLabelProxy "parent"
deviceMacsecParent = AttrLabelProxy
deviceMacsecProtect :: AttrLabelProxy "protect"
deviceMacsecProtect = AttrLabelProxy
deviceMacsecReplayProtect :: AttrLabelProxy "replayProtect"
deviceMacsecReplayProtect = AttrLabelProxy
deviceMacsecScb :: AttrLabelProxy "scb"
deviceMacsecScb = AttrLabelProxy
deviceMacsecSci :: AttrLabelProxy "sci"
deviceMacsecSci = AttrLabelProxy
deviceMacsecValidation :: AttrLabelProxy "validation"
deviceMacsecValidation = AttrLabelProxy
deviceMacsecWindow :: AttrLabelProxy "window"
deviceMacsecWindow = AttrLabelProxy
#endif
#if defined(ENABLE_OVERLOADING)
type instance O.SignalList DeviceMacsec = DeviceMacsecSignalList
type DeviceMacsecSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo), '("stateChanged", NM.Device.DeviceStateChangedSignalInfo)] :: [(Symbol, DK.Type)])
#endif
foreign import ccall "nm_device_macsec_get_cipher_suite" nm_device_macsec_get_cipher_suite ::
Ptr DeviceMacsec ->
IO Word64
deviceMacsecGetCipherSuite ::
(B.CallStack.HasCallStack, MonadIO m, IsDeviceMacsec a) =>
a
-> m Word64
deviceMacsecGetCipherSuite :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDeviceMacsec a) =>
a -> m Word64
deviceMacsecGetCipherSuite a
device = IO Word64 -> m Word64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
Ptr DeviceMacsec
device' <- a -> IO (Ptr DeviceMacsec)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
Word64
result <- Ptr DeviceMacsec -> IO Word64
nm_device_macsec_get_cipher_suite Ptr DeviceMacsec
device'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result
#if defined(ENABLE_OVERLOADING)
data DeviceMacsecGetCipherSuiteMethodInfo
instance (signature ~ (m Word64), MonadIO m, IsDeviceMacsec a) => O.OverloadedMethod DeviceMacsecGetCipherSuiteMethodInfo a signature where
overloadedMethod = deviceMacsecGetCipherSuite
instance O.OverloadedMethodInfo DeviceMacsecGetCipherSuiteMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceMacsec.deviceMacsecGetCipherSuite",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceMacsec.html#v:deviceMacsecGetCipherSuite"
})
#endif
foreign import ccall "nm_device_macsec_get_encoding_sa" nm_device_macsec_get_encoding_sa ::
Ptr DeviceMacsec ->
IO Word8
deviceMacsecGetEncodingSa ::
(B.CallStack.HasCallStack, MonadIO m, IsDeviceMacsec a) =>
a
-> m Word8
deviceMacsecGetEncodingSa :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDeviceMacsec a) =>
a -> m Word8
deviceMacsecGetEncodingSa 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 DeviceMacsec
device' <- a -> IO (Ptr DeviceMacsec)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
Word8
result <- Ptr DeviceMacsec -> IO Word8
nm_device_macsec_get_encoding_sa Ptr DeviceMacsec
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 DeviceMacsecGetEncodingSaMethodInfo
instance (signature ~ (m Word8), MonadIO m, IsDeviceMacsec a) => O.OverloadedMethod DeviceMacsecGetEncodingSaMethodInfo a signature where
overloadedMethod = deviceMacsecGetEncodingSa
instance O.OverloadedMethodInfo DeviceMacsecGetEncodingSaMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceMacsec.deviceMacsecGetEncodingSa",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceMacsec.html#v:deviceMacsecGetEncodingSa"
})
#endif
foreign import ccall "nm_device_macsec_get_encrypt" nm_device_macsec_get_encrypt ::
Ptr DeviceMacsec ->
IO CInt
deviceMacsecGetEncrypt ::
(B.CallStack.HasCallStack, MonadIO m, IsDeviceMacsec a) =>
a
-> m Bool
deviceMacsecGetEncrypt :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDeviceMacsec a) =>
a -> m Bool
deviceMacsecGetEncrypt 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 DeviceMacsec
device' <- a -> IO (Ptr DeviceMacsec)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
CInt
result <- Ptr DeviceMacsec -> IO CInt
nm_device_macsec_get_encrypt Ptr DeviceMacsec
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 DeviceMacsecGetEncryptMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsDeviceMacsec a) => O.OverloadedMethod DeviceMacsecGetEncryptMethodInfo a signature where
overloadedMethod = deviceMacsecGetEncrypt
instance O.OverloadedMethodInfo DeviceMacsecGetEncryptMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceMacsec.deviceMacsecGetEncrypt",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceMacsec.html#v:deviceMacsecGetEncrypt"
})
#endif
foreign import ccall "nm_device_macsec_get_es" nm_device_macsec_get_es ::
Ptr DeviceMacsec ->
IO CInt
deviceMacsecGetEs ::
(B.CallStack.HasCallStack, MonadIO m, IsDeviceMacsec a) =>
a
-> m Bool
deviceMacsecGetEs :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDeviceMacsec a) =>
a -> m Bool
deviceMacsecGetEs 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 DeviceMacsec
device' <- a -> IO (Ptr DeviceMacsec)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
CInt
result <- Ptr DeviceMacsec -> IO CInt
nm_device_macsec_get_es Ptr DeviceMacsec
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 DeviceMacsecGetEsMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsDeviceMacsec a) => O.OverloadedMethod DeviceMacsecGetEsMethodInfo a signature where
overloadedMethod = deviceMacsecGetEs
instance O.OverloadedMethodInfo DeviceMacsecGetEsMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceMacsec.deviceMacsecGetEs",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceMacsec.html#v:deviceMacsecGetEs"
})
#endif
foreign import ccall "nm_device_macsec_get_icv_length" nm_device_macsec_get_icv_length ::
Ptr DeviceMacsec ->
IO Word8
deviceMacsecGetIcvLength ::
(B.CallStack.HasCallStack, MonadIO m, IsDeviceMacsec a) =>
a
-> m Word8
deviceMacsecGetIcvLength :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDeviceMacsec a) =>
a -> m Word8
deviceMacsecGetIcvLength 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 DeviceMacsec
device' <- a -> IO (Ptr DeviceMacsec)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
Word8
result <- Ptr DeviceMacsec -> IO Word8
nm_device_macsec_get_icv_length Ptr DeviceMacsec
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 DeviceMacsecGetIcvLengthMethodInfo
instance (signature ~ (m Word8), MonadIO m, IsDeviceMacsec a) => O.OverloadedMethod DeviceMacsecGetIcvLengthMethodInfo a signature where
overloadedMethod = deviceMacsecGetIcvLength
instance O.OverloadedMethodInfo DeviceMacsecGetIcvLengthMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceMacsec.deviceMacsecGetIcvLength",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceMacsec.html#v:deviceMacsecGetIcvLength"
})
#endif
foreign import ccall "nm_device_macsec_get_include_sci" nm_device_macsec_get_include_sci ::
Ptr DeviceMacsec ->
IO CInt
deviceMacsecGetIncludeSci ::
(B.CallStack.HasCallStack, MonadIO m, IsDeviceMacsec a) =>
a
-> m Bool
deviceMacsecGetIncludeSci :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDeviceMacsec a) =>
a -> m Bool
deviceMacsecGetIncludeSci 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 DeviceMacsec
device' <- a -> IO (Ptr DeviceMacsec)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
CInt
result <- Ptr DeviceMacsec -> IO CInt
nm_device_macsec_get_include_sci Ptr DeviceMacsec
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 DeviceMacsecGetIncludeSciMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsDeviceMacsec a) => O.OverloadedMethod DeviceMacsecGetIncludeSciMethodInfo a signature where
overloadedMethod = deviceMacsecGetIncludeSci
instance O.OverloadedMethodInfo DeviceMacsecGetIncludeSciMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceMacsec.deviceMacsecGetIncludeSci",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceMacsec.html#v:deviceMacsecGetIncludeSci"
})
#endif
foreign import ccall "nm_device_macsec_get_parent" nm_device_macsec_get_parent ::
Ptr DeviceMacsec ->
IO (Ptr NM.Device.Device)
deviceMacsecGetParent ::
(B.CallStack.HasCallStack, MonadIO m, IsDeviceMacsec a) =>
a
-> m NM.Device.Device
deviceMacsecGetParent :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDeviceMacsec a) =>
a -> m Device
deviceMacsecGetParent 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 DeviceMacsec
device' <- a -> IO (Ptr DeviceMacsec)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
Ptr Device
result <- Ptr DeviceMacsec -> IO (Ptr Device)
nm_device_macsec_get_parent Ptr DeviceMacsec
device'
Text -> Ptr Device -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"deviceMacsecGetParent" 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 DeviceMacsecGetParentMethodInfo
instance (signature ~ (m NM.Device.Device), MonadIO m, IsDeviceMacsec a) => O.OverloadedMethod DeviceMacsecGetParentMethodInfo a signature where
overloadedMethod = deviceMacsecGetParent
instance O.OverloadedMethodInfo DeviceMacsecGetParentMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceMacsec.deviceMacsecGetParent",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceMacsec.html#v:deviceMacsecGetParent"
})
#endif
foreign import ccall "nm_device_macsec_get_protect" nm_device_macsec_get_protect ::
Ptr DeviceMacsec ->
IO CInt
deviceMacsecGetProtect ::
(B.CallStack.HasCallStack, MonadIO m, IsDeviceMacsec a) =>
a
-> m Bool
deviceMacsecGetProtect :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDeviceMacsec a) =>
a -> m Bool
deviceMacsecGetProtect 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 DeviceMacsec
device' <- a -> IO (Ptr DeviceMacsec)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
CInt
result <- Ptr DeviceMacsec -> IO CInt
nm_device_macsec_get_protect Ptr DeviceMacsec
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 DeviceMacsecGetProtectMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsDeviceMacsec a) => O.OverloadedMethod DeviceMacsecGetProtectMethodInfo a signature where
overloadedMethod = deviceMacsecGetProtect
instance O.OverloadedMethodInfo DeviceMacsecGetProtectMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceMacsec.deviceMacsecGetProtect",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceMacsec.html#v:deviceMacsecGetProtect"
})
#endif
foreign import ccall "nm_device_macsec_get_replay_protect" nm_device_macsec_get_replay_protect ::
Ptr DeviceMacsec ->
IO CInt
deviceMacsecGetReplayProtect ::
(B.CallStack.HasCallStack, MonadIO m, IsDeviceMacsec a) =>
a
-> m Bool
deviceMacsecGetReplayProtect :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDeviceMacsec a) =>
a -> m Bool
deviceMacsecGetReplayProtect 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 DeviceMacsec
device' <- a -> IO (Ptr DeviceMacsec)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
CInt
result <- Ptr DeviceMacsec -> IO CInt
nm_device_macsec_get_replay_protect Ptr DeviceMacsec
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 DeviceMacsecGetReplayProtectMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsDeviceMacsec a) => O.OverloadedMethod DeviceMacsecGetReplayProtectMethodInfo a signature where
overloadedMethod = deviceMacsecGetReplayProtect
instance O.OverloadedMethodInfo DeviceMacsecGetReplayProtectMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceMacsec.deviceMacsecGetReplayProtect",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceMacsec.html#v:deviceMacsecGetReplayProtect"
})
#endif
foreign import ccall "nm_device_macsec_get_scb" nm_device_macsec_get_scb ::
Ptr DeviceMacsec ->
IO CInt
deviceMacsecGetScb ::
(B.CallStack.HasCallStack, MonadIO m, IsDeviceMacsec a) =>
a
-> m Bool
deviceMacsecGetScb :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDeviceMacsec a) =>
a -> m Bool
deviceMacsecGetScb 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 DeviceMacsec
device' <- a -> IO (Ptr DeviceMacsec)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
CInt
result <- Ptr DeviceMacsec -> IO CInt
nm_device_macsec_get_scb Ptr DeviceMacsec
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 DeviceMacsecGetScbMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsDeviceMacsec a) => O.OverloadedMethod DeviceMacsecGetScbMethodInfo a signature where
overloadedMethod = deviceMacsecGetScb
instance O.OverloadedMethodInfo DeviceMacsecGetScbMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceMacsec.deviceMacsecGetScb",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceMacsec.html#v:deviceMacsecGetScb"
})
#endif
foreign import ccall "nm_device_macsec_get_sci" nm_device_macsec_get_sci ::
Ptr DeviceMacsec ->
IO Word64
deviceMacsecGetSci ::
(B.CallStack.HasCallStack, MonadIO m, IsDeviceMacsec a) =>
a
-> m Word64
deviceMacsecGetSci :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDeviceMacsec a) =>
a -> m Word64
deviceMacsecGetSci a
device = IO Word64 -> m Word64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
Ptr DeviceMacsec
device' <- a -> IO (Ptr DeviceMacsec)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
Word64
result <- Ptr DeviceMacsec -> IO Word64
nm_device_macsec_get_sci Ptr DeviceMacsec
device'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result
#if defined(ENABLE_OVERLOADING)
data DeviceMacsecGetSciMethodInfo
instance (signature ~ (m Word64), MonadIO m, IsDeviceMacsec a) => O.OverloadedMethod DeviceMacsecGetSciMethodInfo a signature where
overloadedMethod = deviceMacsecGetSci
instance O.OverloadedMethodInfo DeviceMacsecGetSciMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceMacsec.deviceMacsecGetSci",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceMacsec.html#v:deviceMacsecGetSci"
})
#endif
foreign import ccall "nm_device_macsec_get_validation" nm_device_macsec_get_validation ::
Ptr DeviceMacsec ->
IO CString
deviceMacsecGetValidation ::
(B.CallStack.HasCallStack, MonadIO m, IsDeviceMacsec a) =>
a
-> m T.Text
deviceMacsecGetValidation :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDeviceMacsec a) =>
a -> m Text
deviceMacsecGetValidation 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 DeviceMacsec
device' <- a -> IO (Ptr DeviceMacsec)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
CString
result <- Ptr DeviceMacsec -> IO CString
nm_device_macsec_get_validation Ptr DeviceMacsec
device'
Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"deviceMacsecGetValidation" 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 DeviceMacsecGetValidationMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsDeviceMacsec a) => O.OverloadedMethod DeviceMacsecGetValidationMethodInfo a signature where
overloadedMethod = deviceMacsecGetValidation
instance O.OverloadedMethodInfo DeviceMacsecGetValidationMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceMacsec.deviceMacsecGetValidation",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceMacsec.html#v:deviceMacsecGetValidation"
})
#endif
foreign import ccall "nm_device_macsec_get_window" nm_device_macsec_get_window ::
Ptr DeviceMacsec ->
IO Word32
deviceMacsecGetWindow ::
(B.CallStack.HasCallStack, MonadIO m, IsDeviceMacsec a) =>
a
-> m Word32
deviceMacsecGetWindow :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDeviceMacsec a) =>
a -> m Word32
deviceMacsecGetWindow 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 DeviceMacsec
device' <- a -> IO (Ptr DeviceMacsec)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
Word32
result <- Ptr DeviceMacsec -> IO Word32
nm_device_macsec_get_window Ptr DeviceMacsec
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 DeviceMacsecGetWindowMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsDeviceMacsec a) => O.OverloadedMethod DeviceMacsecGetWindowMethodInfo a signature where
overloadedMethod = deviceMacsecGetWindow
instance O.OverloadedMethodInfo DeviceMacsecGetWindowMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.DeviceMacsec.deviceMacsecGetWindow",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-DeviceMacsec.html#v:deviceMacsecGetWindow"
})
#endif