{-# LANGUAGE TypeApplications #-}
#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif
module GI.NM.Objects.SettingMacsec
(
SettingMacsec(..) ,
IsSettingMacsec ,
toSettingMacsec ,
#if defined(ENABLE_OVERLOADING)
ResolveSettingMacsecMethod ,
#endif
#if defined(ENABLE_OVERLOADING)
SettingMacsecGetEncryptMethodInfo ,
#endif
settingMacsecGetEncrypt ,
#if defined(ENABLE_OVERLOADING)
SettingMacsecGetMkaCakMethodInfo ,
#endif
settingMacsecGetMkaCak ,
#if defined(ENABLE_OVERLOADING)
SettingMacsecGetMkaCakFlagsMethodInfo ,
#endif
settingMacsecGetMkaCakFlags ,
#if defined(ENABLE_OVERLOADING)
SettingMacsecGetMkaCknMethodInfo ,
#endif
settingMacsecGetMkaCkn ,
#if defined(ENABLE_OVERLOADING)
SettingMacsecGetModeMethodInfo ,
#endif
settingMacsecGetMode ,
#if defined(ENABLE_OVERLOADING)
SettingMacsecGetOffloadMethodInfo ,
#endif
settingMacsecGetOffload ,
#if defined(ENABLE_OVERLOADING)
SettingMacsecGetParentMethodInfo ,
#endif
settingMacsecGetParent ,
#if defined(ENABLE_OVERLOADING)
SettingMacsecGetPortMethodInfo ,
#endif
settingMacsecGetPort ,
#if defined(ENABLE_OVERLOADING)
SettingMacsecGetSendSciMethodInfo ,
#endif
settingMacsecGetSendSci ,
#if defined(ENABLE_OVERLOADING)
SettingMacsecGetValidationMethodInfo ,
#endif
settingMacsecGetValidation ,
settingMacsecNew ,
#if defined(ENABLE_OVERLOADING)
SettingMacsecEncryptPropertyInfo ,
#endif
constructSettingMacsecEncrypt ,
getSettingMacsecEncrypt ,
setSettingMacsecEncrypt ,
#if defined(ENABLE_OVERLOADING)
settingMacsecEncrypt ,
#endif
#if defined(ENABLE_OVERLOADING)
SettingMacsecMkaCakPropertyInfo ,
#endif
clearSettingMacsecMkaCak ,
constructSettingMacsecMkaCak ,
getSettingMacsecMkaCak ,
setSettingMacsecMkaCak ,
#if defined(ENABLE_OVERLOADING)
settingMacsecMkaCak ,
#endif
#if defined(ENABLE_OVERLOADING)
SettingMacsecMkaCakFlagsPropertyInfo ,
#endif
constructSettingMacsecMkaCakFlags ,
getSettingMacsecMkaCakFlags ,
setSettingMacsecMkaCakFlags ,
#if defined(ENABLE_OVERLOADING)
settingMacsecMkaCakFlags ,
#endif
#if defined(ENABLE_OVERLOADING)
SettingMacsecMkaCknPropertyInfo ,
#endif
clearSettingMacsecMkaCkn ,
constructSettingMacsecMkaCkn ,
getSettingMacsecMkaCkn ,
setSettingMacsecMkaCkn ,
#if defined(ENABLE_OVERLOADING)
settingMacsecMkaCkn ,
#endif
#if defined(ENABLE_OVERLOADING)
SettingMacsecModePropertyInfo ,
#endif
constructSettingMacsecMode ,
getSettingMacsecMode ,
setSettingMacsecMode ,
#if defined(ENABLE_OVERLOADING)
settingMacsecMode ,
#endif
#if defined(ENABLE_OVERLOADING)
SettingMacsecOffloadPropertyInfo ,
#endif
constructSettingMacsecOffload ,
getSettingMacsecOffload ,
setSettingMacsecOffload ,
#if defined(ENABLE_OVERLOADING)
settingMacsecOffload ,
#endif
#if defined(ENABLE_OVERLOADING)
SettingMacsecParentPropertyInfo ,
#endif
clearSettingMacsecParent ,
constructSettingMacsecParent ,
getSettingMacsecParent ,
setSettingMacsecParent ,
#if defined(ENABLE_OVERLOADING)
settingMacsecParent ,
#endif
#if defined(ENABLE_OVERLOADING)
SettingMacsecPortPropertyInfo ,
#endif
constructSettingMacsecPort ,
getSettingMacsecPort ,
setSettingMacsecPort ,
#if defined(ENABLE_OVERLOADING)
settingMacsecPort ,
#endif
#if defined(ENABLE_OVERLOADING)
SettingMacsecSendSciPropertyInfo ,
#endif
constructSettingMacsecSendSci ,
getSettingMacsecSendSci ,
setSettingMacsecSendSci ,
#if defined(ENABLE_OVERLOADING)
settingMacsecSendSci ,
#endif
#if defined(ENABLE_OVERLOADING)
SettingMacsecValidationPropertyInfo ,
#endif
constructSettingMacsecValidation ,
getSettingMacsecValidation ,
setSettingMacsecValidation ,
#if defined(ENABLE_OVERLOADING)
settingMacsecValidation ,
#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.VariantType as GLib.VariantType
import qualified GI.GObject.Objects.Object as GObject.Object
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.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.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.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.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.Setting as NM.Setting
#endif
newtype SettingMacsec = SettingMacsec (SP.ManagedPtr SettingMacsec)
deriving (SettingMacsec -> SettingMacsec -> Bool
(SettingMacsec -> SettingMacsec -> Bool)
-> (SettingMacsec -> SettingMacsec -> Bool) -> Eq SettingMacsec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SettingMacsec -> SettingMacsec -> Bool
== :: SettingMacsec -> SettingMacsec -> Bool
$c/= :: SettingMacsec -> SettingMacsec -> Bool
/= :: SettingMacsec -> SettingMacsec -> Bool
Eq)
instance SP.ManagedPtrNewtype SettingMacsec where
toManagedPtr :: SettingMacsec -> ManagedPtr SettingMacsec
toManagedPtr (SettingMacsec ManagedPtr SettingMacsec
p) = ManagedPtr SettingMacsec
p
foreign import ccall "nm_setting_macsec_get_type"
c_nm_setting_macsec_get_type :: IO B.Types.GType
instance B.Types.TypedObject SettingMacsec where
glibType :: IO GType
glibType = IO GType
c_nm_setting_macsec_get_type
instance B.Types.GObject SettingMacsec
class (SP.GObject o, O.IsDescendantOf SettingMacsec o) => IsSettingMacsec o
instance (SP.GObject o, O.IsDescendantOf SettingMacsec o) => IsSettingMacsec o
instance O.HasParentTypes SettingMacsec
type instance O.ParentTypes SettingMacsec = '[NM.Setting.Setting, GObject.Object.Object]
toSettingMacsec :: (MIO.MonadIO m, IsSettingMacsec o) => o -> m SettingMacsec
toSettingMacsec :: forall (m :: * -> *) o.
(MonadIO m, IsSettingMacsec o) =>
o -> m SettingMacsec
toSettingMacsec = IO SettingMacsec -> m SettingMacsec
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO SettingMacsec -> m SettingMacsec)
-> (o -> IO SettingMacsec) -> o -> m SettingMacsec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr SettingMacsec -> SettingMacsec)
-> o -> IO SettingMacsec
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr SettingMacsec -> SettingMacsec
SettingMacsec
instance B.GValue.IsGValue (Maybe SettingMacsec) where
gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_nm_setting_macsec_get_type
gvalueSet_ :: Ptr GValue -> Maybe SettingMacsec -> IO ()
gvalueSet_ Ptr GValue
gv Maybe SettingMacsec
P.Nothing = Ptr GValue -> Ptr SettingMacsec -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr SettingMacsec
forall a. Ptr a
FP.nullPtr :: FP.Ptr SettingMacsec)
gvalueSet_ Ptr GValue
gv (P.Just SettingMacsec
obj) = SettingMacsec -> (Ptr SettingMacsec -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr SettingMacsec
obj (Ptr GValue -> Ptr SettingMacsec -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
gvalueGet_ :: Ptr GValue -> IO (Maybe SettingMacsec)
gvalueGet_ Ptr GValue
gv = do
Ptr SettingMacsec
ptr <- Ptr GValue -> IO (Ptr SettingMacsec)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr SettingMacsec)
if Ptr SettingMacsec
ptr Ptr SettingMacsec -> Ptr SettingMacsec -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr SettingMacsec
forall a. Ptr a
FP.nullPtr
then SettingMacsec -> Maybe SettingMacsec
forall a. a -> Maybe a
P.Just (SettingMacsec -> Maybe SettingMacsec)
-> IO SettingMacsec -> IO (Maybe SettingMacsec)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr SettingMacsec -> SettingMacsec)
-> Ptr SettingMacsec -> IO SettingMacsec
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr SettingMacsec -> SettingMacsec
SettingMacsec Ptr SettingMacsec
ptr
else Maybe SettingMacsec -> IO (Maybe SettingMacsec)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SettingMacsec
forall a. Maybe a
P.Nothing
#if defined(ENABLE_OVERLOADING)
type family ResolveSettingMacsecMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
ResolveSettingMacsecMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
ResolveSettingMacsecMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
ResolveSettingMacsecMethod "compare" o = NM.Setting.SettingCompareMethodInfo
ResolveSettingMacsecMethod "diff" o = NM.Setting.SettingDiffMethodInfo
ResolveSettingMacsecMethod "duplicate" o = NM.Setting.SettingDuplicateMethodInfo
ResolveSettingMacsecMethod "enumerateValues" o = NM.Setting.SettingEnumerateValuesMethodInfo
ResolveSettingMacsecMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
ResolveSettingMacsecMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
ResolveSettingMacsecMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
ResolveSettingMacsecMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
ResolveSettingMacsecMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
ResolveSettingMacsecMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
ResolveSettingMacsecMethod "optionClearByName" o = NM.Setting.SettingOptionClearByNameMethodInfo
ResolveSettingMacsecMethod "optionGet" o = NM.Setting.SettingOptionGetMethodInfo
ResolveSettingMacsecMethod "optionGetAllNames" o = NM.Setting.SettingOptionGetAllNamesMethodInfo
ResolveSettingMacsecMethod "optionGetBoolean" o = NM.Setting.SettingOptionGetBooleanMethodInfo
ResolveSettingMacsecMethod "optionGetUint32" o = NM.Setting.SettingOptionGetUint32MethodInfo
ResolveSettingMacsecMethod "optionSet" o = NM.Setting.SettingOptionSetMethodInfo
ResolveSettingMacsecMethod "optionSetBoolean" o = NM.Setting.SettingOptionSetBooleanMethodInfo
ResolveSettingMacsecMethod "optionSetUint32" o = NM.Setting.SettingOptionSetUint32MethodInfo
ResolveSettingMacsecMethod "ref" o = GObject.Object.ObjectRefMethodInfo
ResolveSettingMacsecMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
ResolveSettingMacsecMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
ResolveSettingMacsecMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
ResolveSettingMacsecMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
ResolveSettingMacsecMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
ResolveSettingMacsecMethod "toString" o = NM.Setting.SettingToStringMethodInfo
ResolveSettingMacsecMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
ResolveSettingMacsecMethod "verify" o = NM.Setting.SettingVerifyMethodInfo
ResolveSettingMacsecMethod "verifySecrets" o = NM.Setting.SettingVerifySecretsMethodInfo
ResolveSettingMacsecMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
ResolveSettingMacsecMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
ResolveSettingMacsecMethod "getDbusPropertyType" o = NM.Setting.SettingGetDbusPropertyTypeMethodInfo
ResolveSettingMacsecMethod "getEncrypt" o = SettingMacsecGetEncryptMethodInfo
ResolveSettingMacsecMethod "getMkaCak" o = SettingMacsecGetMkaCakMethodInfo
ResolveSettingMacsecMethod "getMkaCakFlags" o = SettingMacsecGetMkaCakFlagsMethodInfo
ResolveSettingMacsecMethod "getMkaCkn" o = SettingMacsecGetMkaCknMethodInfo
ResolveSettingMacsecMethod "getMode" o = SettingMacsecGetModeMethodInfo
ResolveSettingMacsecMethod "getName" o = NM.Setting.SettingGetNameMethodInfo
ResolveSettingMacsecMethod "getOffload" o = SettingMacsecGetOffloadMethodInfo
ResolveSettingMacsecMethod "getParent" o = SettingMacsecGetParentMethodInfo
ResolveSettingMacsecMethod "getPort" o = SettingMacsecGetPortMethodInfo
ResolveSettingMacsecMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
ResolveSettingMacsecMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
ResolveSettingMacsecMethod "getSecretFlags" o = NM.Setting.SettingGetSecretFlagsMethodInfo
ResolveSettingMacsecMethod "getSendSci" o = SettingMacsecGetSendSciMethodInfo
ResolveSettingMacsecMethod "getValidation" o = SettingMacsecGetValidationMethodInfo
ResolveSettingMacsecMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
ResolveSettingMacsecMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
ResolveSettingMacsecMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
ResolveSettingMacsecMethod "setSecretFlags" o = NM.Setting.SettingSetSecretFlagsMethodInfo
ResolveSettingMacsecMethod l o = O.MethodResolutionFailed l o
instance (info ~ ResolveSettingMacsecMethod t SettingMacsec, O.OverloadedMethod info SettingMacsec p) => OL.IsLabel t (SettingMacsec -> 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 ~ ResolveSettingMacsecMethod t SettingMacsec, O.OverloadedMethod info SettingMacsec p, R.HasField t SettingMacsec p) => R.HasField t SettingMacsec p where
getField = O.overloadedMethod @info
#endif
instance (info ~ ResolveSettingMacsecMethod t SettingMacsec, O.OverloadedMethodInfo info SettingMacsec) => OL.IsLabel t (O.MethodProxy info SettingMacsec) where
#if MIN_VERSION_base(4,10,0)
fromLabel = O.MethodProxy
#else
fromLabel _ = O.MethodProxy
#endif
#endif
getSettingMacsecEncrypt :: (MonadIO m, IsSettingMacsec o) => o -> m Bool
getSettingMacsecEncrypt :: forall (m :: * -> *) o.
(MonadIO m, IsSettingMacsec o) =>
o -> m Bool
getSettingMacsecEncrypt 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"
setSettingMacsecEncrypt :: (MonadIO m, IsSettingMacsec o) => o -> Bool -> m ()
setSettingMacsecEncrypt :: forall (m :: * -> *) o.
(MonadIO m, IsSettingMacsec o) =>
o -> Bool -> m ()
setSettingMacsecEncrypt o
obj Bool
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"encrypt" Bool
val
constructSettingMacsecEncrypt :: (IsSettingMacsec o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructSettingMacsecEncrypt :: forall o (m :: * -> *).
(IsSettingMacsec o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructSettingMacsecEncrypt Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"encrypt" Bool
val
#if defined(ENABLE_OVERLOADING)
data SettingMacsecEncryptPropertyInfo
instance AttrInfo SettingMacsecEncryptPropertyInfo where
type AttrAllowedOps SettingMacsecEncryptPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint SettingMacsecEncryptPropertyInfo = IsSettingMacsec
type AttrSetTypeConstraint SettingMacsecEncryptPropertyInfo = (~) Bool
type AttrTransferTypeConstraint SettingMacsecEncryptPropertyInfo = (~) Bool
type AttrTransferType SettingMacsecEncryptPropertyInfo = Bool
type AttrGetType SettingMacsecEncryptPropertyInfo = Bool
type AttrLabel SettingMacsecEncryptPropertyInfo = "encrypt"
type AttrOrigin SettingMacsecEncryptPropertyInfo = SettingMacsec
attrGet = getSettingMacsecEncrypt
attrSet = setSettingMacsecEncrypt
attrTransfer _ v = do
return v
attrConstruct = constructSettingMacsecEncrypt
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingMacsec.encrypt"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingMacsec.html#g:attr:encrypt"
})
#endif
getSettingMacsecMkaCak :: (MonadIO m, IsSettingMacsec o) => o -> m T.Text
getSettingMacsecMkaCak :: forall (m :: * -> *) o.
(MonadIO m, IsSettingMacsec o) =>
o -> m Text
getSettingMacsecMkaCak 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
"getSettingMacsecMkaCak" (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
"mka-cak"
setSettingMacsecMkaCak :: (MonadIO m, IsSettingMacsec o) => o -> T.Text -> m ()
setSettingMacsecMkaCak :: forall (m :: * -> *) o.
(MonadIO m, IsSettingMacsec o) =>
o -> Text -> m ()
setSettingMacsecMkaCak o
obj Text
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"mka-cak" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)
constructSettingMacsecMkaCak :: (IsSettingMacsec o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructSettingMacsecMkaCak :: forall o (m :: * -> *).
(IsSettingMacsec o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructSettingMacsecMkaCak Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"mka-cak" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)
clearSettingMacsecMkaCak :: (MonadIO m, IsSettingMacsec o) => o -> m ()
clearSettingMacsecMkaCak :: forall (m :: * -> *) o. (MonadIO m, IsSettingMacsec o) => o -> m ()
clearSettingMacsecMkaCak o
obj = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"mka-cak" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)
#if defined(ENABLE_OVERLOADING)
data SettingMacsecMkaCakPropertyInfo
instance AttrInfo SettingMacsecMkaCakPropertyInfo where
type AttrAllowedOps SettingMacsecMkaCakPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint SettingMacsecMkaCakPropertyInfo = IsSettingMacsec
type AttrSetTypeConstraint SettingMacsecMkaCakPropertyInfo = (~) T.Text
type AttrTransferTypeConstraint SettingMacsecMkaCakPropertyInfo = (~) T.Text
type AttrTransferType SettingMacsecMkaCakPropertyInfo = T.Text
type AttrGetType SettingMacsecMkaCakPropertyInfo = T.Text
type AttrLabel SettingMacsecMkaCakPropertyInfo = "mka-cak"
type AttrOrigin SettingMacsecMkaCakPropertyInfo = SettingMacsec
attrGet = getSettingMacsecMkaCak
attrSet = setSettingMacsecMkaCak
attrTransfer _ v = do
return v
attrConstruct = constructSettingMacsecMkaCak
attrClear = clearSettingMacsecMkaCak
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingMacsec.mkaCak"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingMacsec.html#g:attr:mkaCak"
})
#endif
getSettingMacsecMkaCakFlags :: (MonadIO m, IsSettingMacsec o) => o -> m [NM.Flags.SettingSecretFlags]
getSettingMacsecMkaCakFlags :: forall (m :: * -> *) o.
(MonadIO m, IsSettingMacsec o) =>
o -> m [SettingSecretFlags]
getSettingMacsecMkaCakFlags o
obj = IO [SettingSecretFlags] -> m [SettingSecretFlags]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO [SettingSecretFlags] -> m [SettingSecretFlags])
-> IO [SettingSecretFlags] -> m [SettingSecretFlags]
forall a b. (a -> b) -> a -> b
$ o -> String -> IO [SettingSecretFlags]
forall a b.
(GObject a, IsGFlag b, BoxedFlags b) =>
a -> String -> IO [b]
B.Properties.getObjectPropertyFlags o
obj String
"mka-cak-flags"
setSettingMacsecMkaCakFlags :: (MonadIO m, IsSettingMacsec o) => o -> [NM.Flags.SettingSecretFlags] -> m ()
setSettingMacsecMkaCakFlags :: forall (m :: * -> *) o.
(MonadIO m, IsSettingMacsec o) =>
o -> [SettingSecretFlags] -> m ()
setSettingMacsecMkaCakFlags o
obj [SettingSecretFlags]
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
o -> String -> [SettingSecretFlags] -> IO ()
forall a b.
(IsGFlag b, BoxedFlags b, GObject a) =>
a -> String -> [b] -> IO ()
B.Properties.setObjectPropertyFlags o
obj String
"mka-cak-flags" [SettingSecretFlags]
val
constructSettingMacsecMkaCakFlags :: (IsSettingMacsec o, MIO.MonadIO m) => [NM.Flags.SettingSecretFlags] -> m (GValueConstruct o)
constructSettingMacsecMkaCakFlags :: forall o (m :: * -> *).
(IsSettingMacsec o, MonadIO m) =>
[SettingSecretFlags] -> m (GValueConstruct o)
constructSettingMacsecMkaCakFlags [SettingSecretFlags]
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> [SettingSecretFlags] -> IO (GValueConstruct o)
forall a o.
(IsGFlag a, BoxedFlags a) =>
String -> [a] -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyFlags String
"mka-cak-flags" [SettingSecretFlags]
val
#if defined(ENABLE_OVERLOADING)
data SettingMacsecMkaCakFlagsPropertyInfo
instance AttrInfo SettingMacsecMkaCakFlagsPropertyInfo where
type AttrAllowedOps SettingMacsecMkaCakFlagsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint SettingMacsecMkaCakFlagsPropertyInfo = IsSettingMacsec
type AttrSetTypeConstraint SettingMacsecMkaCakFlagsPropertyInfo = (~) [NM.Flags.SettingSecretFlags]
type AttrTransferTypeConstraint SettingMacsecMkaCakFlagsPropertyInfo = (~) [NM.Flags.SettingSecretFlags]
type AttrTransferType SettingMacsecMkaCakFlagsPropertyInfo = [NM.Flags.SettingSecretFlags]
type AttrGetType SettingMacsecMkaCakFlagsPropertyInfo = [NM.Flags.SettingSecretFlags]
type AttrLabel SettingMacsecMkaCakFlagsPropertyInfo = "mka-cak-flags"
type AttrOrigin SettingMacsecMkaCakFlagsPropertyInfo = SettingMacsec
attrGet = getSettingMacsecMkaCakFlags
attrSet = setSettingMacsecMkaCakFlags
attrTransfer _ v = do
return v
attrConstruct = constructSettingMacsecMkaCakFlags
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingMacsec.mkaCakFlags"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingMacsec.html#g:attr:mkaCakFlags"
})
#endif
getSettingMacsecMkaCkn :: (MonadIO m, IsSettingMacsec o) => o -> m T.Text
getSettingMacsecMkaCkn :: forall (m :: * -> *) o.
(MonadIO m, IsSettingMacsec o) =>
o -> m Text
getSettingMacsecMkaCkn 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
"getSettingMacsecMkaCkn" (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
"mka-ckn"
setSettingMacsecMkaCkn :: (MonadIO m, IsSettingMacsec o) => o -> T.Text -> m ()
setSettingMacsecMkaCkn :: forall (m :: * -> *) o.
(MonadIO m, IsSettingMacsec o) =>
o -> Text -> m ()
setSettingMacsecMkaCkn o
obj Text
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"mka-ckn" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)
constructSettingMacsecMkaCkn :: (IsSettingMacsec o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructSettingMacsecMkaCkn :: forall o (m :: * -> *).
(IsSettingMacsec o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructSettingMacsecMkaCkn Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"mka-ckn" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)
clearSettingMacsecMkaCkn :: (MonadIO m, IsSettingMacsec o) => o -> m ()
clearSettingMacsecMkaCkn :: forall (m :: * -> *) o. (MonadIO m, IsSettingMacsec o) => o -> m ()
clearSettingMacsecMkaCkn o
obj = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"mka-ckn" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)
#if defined(ENABLE_OVERLOADING)
data SettingMacsecMkaCknPropertyInfo
instance AttrInfo SettingMacsecMkaCknPropertyInfo where
type AttrAllowedOps SettingMacsecMkaCknPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint SettingMacsecMkaCknPropertyInfo = IsSettingMacsec
type AttrSetTypeConstraint SettingMacsecMkaCknPropertyInfo = (~) T.Text
type AttrTransferTypeConstraint SettingMacsecMkaCknPropertyInfo = (~) T.Text
type AttrTransferType SettingMacsecMkaCknPropertyInfo = T.Text
type AttrGetType SettingMacsecMkaCknPropertyInfo = T.Text
type AttrLabel SettingMacsecMkaCknPropertyInfo = "mka-ckn"
type AttrOrigin SettingMacsecMkaCknPropertyInfo = SettingMacsec
attrGet = getSettingMacsecMkaCkn
attrSet = setSettingMacsecMkaCkn
attrTransfer _ v = do
return v
attrConstruct = constructSettingMacsecMkaCkn
attrClear = clearSettingMacsecMkaCkn
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingMacsec.mkaCkn"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingMacsec.html#g:attr:mkaCkn"
})
#endif
getSettingMacsecMode :: (MonadIO m, IsSettingMacsec o) => o -> m Int32
getSettingMacsecMode :: forall (m :: * -> *) o.
(MonadIO m, IsSettingMacsec o) =>
o -> m Int32
getSettingMacsecMode o
obj = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj String
"mode"
setSettingMacsecMode :: (MonadIO m, IsSettingMacsec o) => o -> Int32 -> m ()
setSettingMacsecMode :: forall (m :: * -> *) o.
(MonadIO m, IsSettingMacsec o) =>
o -> Int32 -> m ()
setSettingMacsecMode o
obj Int32
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
o -> String -> Int32 -> IO ()
forall a. GObject a => a -> String -> Int32 -> IO ()
B.Properties.setObjectPropertyInt32 o
obj String
"mode" Int32
val
constructSettingMacsecMode :: (IsSettingMacsec o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructSettingMacsecMode :: forall o (m :: * -> *).
(IsSettingMacsec o, MonadIO m) =>
Int32 -> m (GValueConstruct o)
constructSettingMacsecMode Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"mode" Int32
val
#if defined(ENABLE_OVERLOADING)
data SettingMacsecModePropertyInfo
instance AttrInfo SettingMacsecModePropertyInfo where
type AttrAllowedOps SettingMacsecModePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint SettingMacsecModePropertyInfo = IsSettingMacsec
type AttrSetTypeConstraint SettingMacsecModePropertyInfo = (~) Int32
type AttrTransferTypeConstraint SettingMacsecModePropertyInfo = (~) Int32
type AttrTransferType SettingMacsecModePropertyInfo = Int32
type AttrGetType SettingMacsecModePropertyInfo = Int32
type AttrLabel SettingMacsecModePropertyInfo = "mode"
type AttrOrigin SettingMacsecModePropertyInfo = SettingMacsec
attrGet = getSettingMacsecMode
attrSet = setSettingMacsecMode
attrTransfer _ v = do
return v
attrConstruct = constructSettingMacsecMode
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingMacsec.mode"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingMacsec.html#g:attr:mode"
})
#endif
getSettingMacsecOffload :: (MonadIO m, IsSettingMacsec o) => o -> m Int32
getSettingMacsecOffload :: forall (m :: * -> *) o.
(MonadIO m, IsSettingMacsec o) =>
o -> m Int32
getSettingMacsecOffload o
obj = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj String
"offload"
setSettingMacsecOffload :: (MonadIO m, IsSettingMacsec o) => o -> Int32 -> m ()
setSettingMacsecOffload :: forall (m :: * -> *) o.
(MonadIO m, IsSettingMacsec o) =>
o -> Int32 -> m ()
setSettingMacsecOffload o
obj Int32
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
o -> String -> Int32 -> IO ()
forall a. GObject a => a -> String -> Int32 -> IO ()
B.Properties.setObjectPropertyInt32 o
obj String
"offload" Int32
val
constructSettingMacsecOffload :: (IsSettingMacsec o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructSettingMacsecOffload :: forall o (m :: * -> *).
(IsSettingMacsec o, MonadIO m) =>
Int32 -> m (GValueConstruct o)
constructSettingMacsecOffload Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"offload" Int32
val
#if defined(ENABLE_OVERLOADING)
data SettingMacsecOffloadPropertyInfo
instance AttrInfo SettingMacsecOffloadPropertyInfo where
type AttrAllowedOps SettingMacsecOffloadPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint SettingMacsecOffloadPropertyInfo = IsSettingMacsec
type AttrSetTypeConstraint SettingMacsecOffloadPropertyInfo = (~) Int32
type AttrTransferTypeConstraint SettingMacsecOffloadPropertyInfo = (~) Int32
type AttrTransferType SettingMacsecOffloadPropertyInfo = Int32
type AttrGetType SettingMacsecOffloadPropertyInfo = Int32
type AttrLabel SettingMacsecOffloadPropertyInfo = "offload"
type AttrOrigin SettingMacsecOffloadPropertyInfo = SettingMacsec
attrGet = getSettingMacsecOffload
attrSet = setSettingMacsecOffload
attrTransfer _ v = do
return v
attrConstruct = constructSettingMacsecOffload
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingMacsec.offload"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingMacsec.html#g:attr:offload"
})
#endif
getSettingMacsecParent :: (MonadIO m, IsSettingMacsec o) => o -> m T.Text
getSettingMacsecParent :: forall (m :: * -> *) o.
(MonadIO m, IsSettingMacsec o) =>
o -> m Text
getSettingMacsecParent 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
"getSettingMacsecParent" (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
"parent"
setSettingMacsecParent :: (MonadIO m, IsSettingMacsec o) => o -> T.Text -> m ()
setSettingMacsecParent :: forall (m :: * -> *) o.
(MonadIO m, IsSettingMacsec o) =>
o -> Text -> m ()
setSettingMacsecParent o
obj Text
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"parent" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)
constructSettingMacsecParent :: (IsSettingMacsec o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructSettingMacsecParent :: forall o (m :: * -> *).
(IsSettingMacsec o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructSettingMacsecParent Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"parent" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)
clearSettingMacsecParent :: (MonadIO m, IsSettingMacsec o) => o -> m ()
clearSettingMacsecParent :: forall (m :: * -> *) o. (MonadIO m, IsSettingMacsec o) => o -> m ()
clearSettingMacsecParent o
obj = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"parent" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)
#if defined(ENABLE_OVERLOADING)
data SettingMacsecParentPropertyInfo
instance AttrInfo SettingMacsecParentPropertyInfo where
type AttrAllowedOps SettingMacsecParentPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint SettingMacsecParentPropertyInfo = IsSettingMacsec
type AttrSetTypeConstraint SettingMacsecParentPropertyInfo = (~) T.Text
type AttrTransferTypeConstraint SettingMacsecParentPropertyInfo = (~) T.Text
type AttrTransferType SettingMacsecParentPropertyInfo = T.Text
type AttrGetType SettingMacsecParentPropertyInfo = T.Text
type AttrLabel SettingMacsecParentPropertyInfo = "parent"
type AttrOrigin SettingMacsecParentPropertyInfo = SettingMacsec
attrGet = getSettingMacsecParent
attrSet = setSettingMacsecParent
attrTransfer _ v = do
return v
attrConstruct = constructSettingMacsecParent
attrClear = clearSettingMacsecParent
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingMacsec.parent"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingMacsec.html#g:attr:parent"
})
#endif
getSettingMacsecPort :: (MonadIO m, IsSettingMacsec o) => o -> m Int32
getSettingMacsecPort :: forall (m :: * -> *) o.
(MonadIO m, IsSettingMacsec o) =>
o -> m Int32
getSettingMacsecPort o
obj = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj String
"port"
setSettingMacsecPort :: (MonadIO m, IsSettingMacsec o) => o -> Int32 -> m ()
setSettingMacsecPort :: forall (m :: * -> *) o.
(MonadIO m, IsSettingMacsec o) =>
o -> Int32 -> m ()
setSettingMacsecPort o
obj Int32
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
o -> String -> Int32 -> IO ()
forall a. GObject a => a -> String -> Int32 -> IO ()
B.Properties.setObjectPropertyInt32 o
obj String
"port" Int32
val
constructSettingMacsecPort :: (IsSettingMacsec o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructSettingMacsecPort :: forall o (m :: * -> *).
(IsSettingMacsec o, MonadIO m) =>
Int32 -> m (GValueConstruct o)
constructSettingMacsecPort Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"port" Int32
val
#if defined(ENABLE_OVERLOADING)
data SettingMacsecPortPropertyInfo
instance AttrInfo SettingMacsecPortPropertyInfo where
type AttrAllowedOps SettingMacsecPortPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint SettingMacsecPortPropertyInfo = IsSettingMacsec
type AttrSetTypeConstraint SettingMacsecPortPropertyInfo = (~) Int32
type AttrTransferTypeConstraint SettingMacsecPortPropertyInfo = (~) Int32
type AttrTransferType SettingMacsecPortPropertyInfo = Int32
type AttrGetType SettingMacsecPortPropertyInfo = Int32
type AttrLabel SettingMacsecPortPropertyInfo = "port"
type AttrOrigin SettingMacsecPortPropertyInfo = SettingMacsec
attrGet = getSettingMacsecPort
attrSet = setSettingMacsecPort
attrTransfer _ v = do
return v
attrConstruct = constructSettingMacsecPort
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingMacsec.port"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingMacsec.html#g:attr:port"
})
#endif
getSettingMacsecSendSci :: (MonadIO m, IsSettingMacsec o) => o -> m Bool
getSettingMacsecSendSci :: forall (m :: * -> *) o.
(MonadIO m, IsSettingMacsec o) =>
o -> m Bool
getSettingMacsecSendSci 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
"send-sci"
setSettingMacsecSendSci :: (MonadIO m, IsSettingMacsec o) => o -> Bool -> m ()
setSettingMacsecSendSci :: forall (m :: * -> *) o.
(MonadIO m, IsSettingMacsec o) =>
o -> Bool -> m ()
setSettingMacsecSendSci o
obj Bool
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"send-sci" Bool
val
constructSettingMacsecSendSci :: (IsSettingMacsec o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructSettingMacsecSendSci :: forall o (m :: * -> *).
(IsSettingMacsec o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructSettingMacsecSendSci Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"send-sci" Bool
val
#if defined(ENABLE_OVERLOADING)
data SettingMacsecSendSciPropertyInfo
instance AttrInfo SettingMacsecSendSciPropertyInfo where
type AttrAllowedOps SettingMacsecSendSciPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint SettingMacsecSendSciPropertyInfo = IsSettingMacsec
type AttrSetTypeConstraint SettingMacsecSendSciPropertyInfo = (~) Bool
type AttrTransferTypeConstraint SettingMacsecSendSciPropertyInfo = (~) Bool
type AttrTransferType SettingMacsecSendSciPropertyInfo = Bool
type AttrGetType SettingMacsecSendSciPropertyInfo = Bool
type AttrLabel SettingMacsecSendSciPropertyInfo = "send-sci"
type AttrOrigin SettingMacsecSendSciPropertyInfo = SettingMacsec
attrGet = getSettingMacsecSendSci
attrSet = setSettingMacsecSendSci
attrTransfer _ v = do
return v
attrConstruct = constructSettingMacsecSendSci
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingMacsec.sendSci"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingMacsec.html#g:attr:sendSci"
})
#endif
getSettingMacsecValidation :: (MonadIO m, IsSettingMacsec o) => o -> m Int32
getSettingMacsecValidation :: forall (m :: * -> *) o.
(MonadIO m, IsSettingMacsec o) =>
o -> m Int32
getSettingMacsecValidation o
obj = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj String
"validation"
setSettingMacsecValidation :: (MonadIO m, IsSettingMacsec o) => o -> Int32 -> m ()
setSettingMacsecValidation :: forall (m :: * -> *) o.
(MonadIO m, IsSettingMacsec o) =>
o -> Int32 -> m ()
setSettingMacsecValidation o
obj Int32
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
o -> String -> Int32 -> IO ()
forall a. GObject a => a -> String -> Int32 -> IO ()
B.Properties.setObjectPropertyInt32 o
obj String
"validation" Int32
val
constructSettingMacsecValidation :: (IsSettingMacsec o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructSettingMacsecValidation :: forall o (m :: * -> *).
(IsSettingMacsec o, MonadIO m) =>
Int32 -> m (GValueConstruct o)
constructSettingMacsecValidation Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"validation" Int32
val
#if defined(ENABLE_OVERLOADING)
data SettingMacsecValidationPropertyInfo
instance AttrInfo SettingMacsecValidationPropertyInfo where
type AttrAllowedOps SettingMacsecValidationPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint SettingMacsecValidationPropertyInfo = IsSettingMacsec
type AttrSetTypeConstraint SettingMacsecValidationPropertyInfo = (~) Int32
type AttrTransferTypeConstraint SettingMacsecValidationPropertyInfo = (~) Int32
type AttrTransferType SettingMacsecValidationPropertyInfo = Int32
type AttrGetType SettingMacsecValidationPropertyInfo = Int32
type AttrLabel SettingMacsecValidationPropertyInfo = "validation"
type AttrOrigin SettingMacsecValidationPropertyInfo = SettingMacsec
attrGet = getSettingMacsecValidation
attrSet = setSettingMacsecValidation
attrTransfer _ v = do
return v
attrConstruct = constructSettingMacsecValidation
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingMacsec.validation"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingMacsec.html#g:attr:validation"
})
#endif
#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList SettingMacsec
type instance O.AttributeList SettingMacsec = SettingMacsecAttributeList
type SettingMacsecAttributeList = ('[ '("encrypt", SettingMacsecEncryptPropertyInfo), '("mkaCak", SettingMacsecMkaCakPropertyInfo), '("mkaCakFlags", SettingMacsecMkaCakFlagsPropertyInfo), '("mkaCkn", SettingMacsecMkaCknPropertyInfo), '("mode", SettingMacsecModePropertyInfo), '("name", NM.Setting.SettingNamePropertyInfo), '("offload", SettingMacsecOffloadPropertyInfo), '("parent", SettingMacsecParentPropertyInfo), '("port", SettingMacsecPortPropertyInfo), '("sendSci", SettingMacsecSendSciPropertyInfo), '("validation", SettingMacsecValidationPropertyInfo)] :: [(Symbol, DK.Type)])
#endif
#if defined(ENABLE_OVERLOADING)
settingMacsecEncrypt :: AttrLabelProxy "encrypt"
settingMacsecEncrypt = AttrLabelProxy
settingMacsecMkaCak :: AttrLabelProxy "mkaCak"
settingMacsecMkaCak = AttrLabelProxy
settingMacsecMkaCakFlags :: AttrLabelProxy "mkaCakFlags"
settingMacsecMkaCakFlags = AttrLabelProxy
settingMacsecMkaCkn :: AttrLabelProxy "mkaCkn"
settingMacsecMkaCkn = AttrLabelProxy
settingMacsecMode :: AttrLabelProxy "mode"
settingMacsecMode = AttrLabelProxy
settingMacsecOffload :: AttrLabelProxy "offload"
settingMacsecOffload = AttrLabelProxy
settingMacsecParent :: AttrLabelProxy "parent"
settingMacsecParent = AttrLabelProxy
settingMacsecPort :: AttrLabelProxy "port"
settingMacsecPort = AttrLabelProxy
settingMacsecSendSci :: AttrLabelProxy "sendSci"
settingMacsecSendSci = AttrLabelProxy
settingMacsecValidation :: AttrLabelProxy "validation"
settingMacsecValidation = AttrLabelProxy
#endif
#if defined(ENABLE_OVERLOADING)
type instance O.SignalList SettingMacsec = SettingMacsecSignalList
type SettingMacsecSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])
#endif
foreign import ccall "nm_setting_macsec_new" nm_setting_macsec_new ::
IO (Ptr SettingMacsec)
settingMacsecNew ::
(B.CallStack.HasCallStack, MonadIO m) =>
m SettingMacsec
settingMacsecNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m SettingMacsec
settingMacsecNew = IO SettingMacsec -> m SettingMacsec
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SettingMacsec -> m SettingMacsec)
-> IO SettingMacsec -> m SettingMacsec
forall a b. (a -> b) -> a -> b
$ do
Ptr SettingMacsec
result <- IO (Ptr SettingMacsec)
nm_setting_macsec_new
Text -> Ptr SettingMacsec -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"settingMacsecNew" Ptr SettingMacsec
result
SettingMacsec
result' <- ((ManagedPtr SettingMacsec -> SettingMacsec)
-> Ptr SettingMacsec -> IO SettingMacsec
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr SettingMacsec -> SettingMacsec
SettingMacsec) Ptr SettingMacsec
result
SettingMacsec -> IO SettingMacsec
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SettingMacsec
result'
#if defined(ENABLE_OVERLOADING)
#endif
foreign import ccall "nm_setting_macsec_get_encrypt" nm_setting_macsec_get_encrypt ::
Ptr SettingMacsec ->
IO CInt
settingMacsecGetEncrypt ::
(B.CallStack.HasCallStack, MonadIO m, IsSettingMacsec a) =>
a
-> m Bool
settingMacsecGetEncrypt :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingMacsec a) =>
a -> m Bool
settingMacsecGetEncrypt a
setting = 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 SettingMacsec
setting' <- a -> IO (Ptr SettingMacsec)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
setting
CInt
result <- Ptr SettingMacsec -> IO CInt
nm_setting_macsec_get_encrypt Ptr SettingMacsec
setting'
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
setting
Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data SettingMacsecGetEncryptMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsSettingMacsec a) => O.OverloadedMethod SettingMacsecGetEncryptMethodInfo a signature where
overloadedMethod = settingMacsecGetEncrypt
instance O.OverloadedMethodInfo SettingMacsecGetEncryptMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingMacsec.settingMacsecGetEncrypt",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingMacsec.html#v:settingMacsecGetEncrypt"
})
#endif
foreign import ccall "nm_setting_macsec_get_mka_cak" nm_setting_macsec_get_mka_cak ::
Ptr SettingMacsec ->
IO CString
settingMacsecGetMkaCak ::
(B.CallStack.HasCallStack, MonadIO m, IsSettingMacsec a) =>
a
-> m T.Text
settingMacsecGetMkaCak :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingMacsec a) =>
a -> m Text
settingMacsecGetMkaCak a
setting = 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 SettingMacsec
setting' <- a -> IO (Ptr SettingMacsec)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
setting
CString
result <- Ptr SettingMacsec -> IO CString
nm_setting_macsec_get_mka_cak Ptr SettingMacsec
setting'
Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"settingMacsecGetMkaCak" CString
result
Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
setting
Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'
#if defined(ENABLE_OVERLOADING)
data SettingMacsecGetMkaCakMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsSettingMacsec a) => O.OverloadedMethod SettingMacsecGetMkaCakMethodInfo a signature where
overloadedMethod = settingMacsecGetMkaCak
instance O.OverloadedMethodInfo SettingMacsecGetMkaCakMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingMacsec.settingMacsecGetMkaCak",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingMacsec.html#v:settingMacsecGetMkaCak"
})
#endif
foreign import ccall "nm_setting_macsec_get_mka_cak_flags" nm_setting_macsec_get_mka_cak_flags ::
Ptr SettingMacsec ->
IO CUInt
settingMacsecGetMkaCakFlags ::
(B.CallStack.HasCallStack, MonadIO m, IsSettingMacsec a) =>
a
-> m [NM.Flags.SettingSecretFlags]
settingMacsecGetMkaCakFlags :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingMacsec a) =>
a -> m [SettingSecretFlags]
settingMacsecGetMkaCakFlags a
setting = IO [SettingSecretFlags] -> m [SettingSecretFlags]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [SettingSecretFlags] -> m [SettingSecretFlags])
-> IO [SettingSecretFlags] -> m [SettingSecretFlags]
forall a b. (a -> b) -> a -> b
$ do
Ptr SettingMacsec
setting' <- a -> IO (Ptr SettingMacsec)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
setting
CUInt
result <- Ptr SettingMacsec -> IO CUInt
nm_setting_macsec_get_mka_cak_flags Ptr SettingMacsec
setting'
let result' :: [SettingSecretFlags]
result' = CUInt -> [SettingSecretFlags]
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
setting
[SettingSecretFlags] -> IO [SettingSecretFlags]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [SettingSecretFlags]
result'
#if defined(ENABLE_OVERLOADING)
data SettingMacsecGetMkaCakFlagsMethodInfo
instance (signature ~ (m [NM.Flags.SettingSecretFlags]), MonadIO m, IsSettingMacsec a) => O.OverloadedMethod SettingMacsecGetMkaCakFlagsMethodInfo a signature where
overloadedMethod = settingMacsecGetMkaCakFlags
instance O.OverloadedMethodInfo SettingMacsecGetMkaCakFlagsMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingMacsec.settingMacsecGetMkaCakFlags",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingMacsec.html#v:settingMacsecGetMkaCakFlags"
})
#endif
foreign import ccall "nm_setting_macsec_get_mka_ckn" nm_setting_macsec_get_mka_ckn ::
Ptr SettingMacsec ->
IO CString
settingMacsecGetMkaCkn ::
(B.CallStack.HasCallStack, MonadIO m, IsSettingMacsec a) =>
a
-> m T.Text
settingMacsecGetMkaCkn :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingMacsec a) =>
a -> m Text
settingMacsecGetMkaCkn a
setting = 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 SettingMacsec
setting' <- a -> IO (Ptr SettingMacsec)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
setting
CString
result <- Ptr SettingMacsec -> IO CString
nm_setting_macsec_get_mka_ckn Ptr SettingMacsec
setting'
Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"settingMacsecGetMkaCkn" CString
result
Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
setting
Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'
#if defined(ENABLE_OVERLOADING)
data SettingMacsecGetMkaCknMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsSettingMacsec a) => O.OverloadedMethod SettingMacsecGetMkaCknMethodInfo a signature where
overloadedMethod = settingMacsecGetMkaCkn
instance O.OverloadedMethodInfo SettingMacsecGetMkaCknMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingMacsec.settingMacsecGetMkaCkn",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingMacsec.html#v:settingMacsecGetMkaCkn"
})
#endif
foreign import ccall "nm_setting_macsec_get_mode" nm_setting_macsec_get_mode ::
Ptr SettingMacsec ->
IO CUInt
settingMacsecGetMode ::
(B.CallStack.HasCallStack, MonadIO m, IsSettingMacsec a) =>
a
-> m NM.Enums.SettingMacsecMode
settingMacsecGetMode :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingMacsec a) =>
a -> m SettingMacsecMode
settingMacsecGetMode a
setting = IO SettingMacsecMode -> m SettingMacsecMode
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SettingMacsecMode -> m SettingMacsecMode)
-> IO SettingMacsecMode -> m SettingMacsecMode
forall a b. (a -> b) -> a -> b
$ do
Ptr SettingMacsec
setting' <- a -> IO (Ptr SettingMacsec)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
setting
CUInt
result <- Ptr SettingMacsec -> IO CUInt
nm_setting_macsec_get_mode Ptr SettingMacsec
setting'
let result' :: SettingMacsecMode
result' = (Int -> SettingMacsecMode
forall a. Enum a => Int -> a
toEnum (Int -> SettingMacsecMode)
-> (CUInt -> Int) -> CUInt -> SettingMacsecMode
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
setting
SettingMacsecMode -> IO SettingMacsecMode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SettingMacsecMode
result'
#if defined(ENABLE_OVERLOADING)
data SettingMacsecGetModeMethodInfo
instance (signature ~ (m NM.Enums.SettingMacsecMode), MonadIO m, IsSettingMacsec a) => O.OverloadedMethod SettingMacsecGetModeMethodInfo a signature where
overloadedMethod = settingMacsecGetMode
instance O.OverloadedMethodInfo SettingMacsecGetModeMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingMacsec.settingMacsecGetMode",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingMacsec.html#v:settingMacsecGetMode"
})
#endif
foreign import ccall "nm_setting_macsec_get_offload" nm_setting_macsec_get_offload ::
Ptr SettingMacsec ->
IO CInt
settingMacsecGetOffload ::
(B.CallStack.HasCallStack, MonadIO m, IsSettingMacsec a) =>
a
-> m NM.Enums.SettingMacsecOffload
settingMacsecGetOffload :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingMacsec a) =>
a -> m SettingMacsecOffload
settingMacsecGetOffload a
setting = IO SettingMacsecOffload -> m SettingMacsecOffload
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SettingMacsecOffload -> m SettingMacsecOffload)
-> IO SettingMacsecOffload -> m SettingMacsecOffload
forall a b. (a -> b) -> a -> b
$ do
Ptr SettingMacsec
setting' <- a -> IO (Ptr SettingMacsec)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
setting
CInt
result <- Ptr SettingMacsec -> IO CInt
nm_setting_macsec_get_offload Ptr SettingMacsec
setting'
let result' :: SettingMacsecOffload
result' = (Int -> SettingMacsecOffload
forall a. Enum a => Int -> a
toEnum (Int -> SettingMacsecOffload)
-> (CInt -> Int) -> CInt -> SettingMacsecOffload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CInt
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
setting
SettingMacsecOffload -> IO SettingMacsecOffload
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SettingMacsecOffload
result'
#if defined(ENABLE_OVERLOADING)
data SettingMacsecGetOffloadMethodInfo
instance (signature ~ (m NM.Enums.SettingMacsecOffload), MonadIO m, IsSettingMacsec a) => O.OverloadedMethod SettingMacsecGetOffloadMethodInfo a signature where
overloadedMethod = settingMacsecGetOffload
instance O.OverloadedMethodInfo SettingMacsecGetOffloadMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingMacsec.settingMacsecGetOffload",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingMacsec.html#v:settingMacsecGetOffload"
})
#endif
foreign import ccall "nm_setting_macsec_get_parent" nm_setting_macsec_get_parent ::
Ptr SettingMacsec ->
IO CString
settingMacsecGetParent ::
(B.CallStack.HasCallStack, MonadIO m, IsSettingMacsec a) =>
a
-> m T.Text
settingMacsecGetParent :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingMacsec a) =>
a -> m Text
settingMacsecGetParent a
setting = 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 SettingMacsec
setting' <- a -> IO (Ptr SettingMacsec)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
setting
CString
result <- Ptr SettingMacsec -> IO CString
nm_setting_macsec_get_parent Ptr SettingMacsec
setting'
Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"settingMacsecGetParent" CString
result
Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
setting
Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'
#if defined(ENABLE_OVERLOADING)
data SettingMacsecGetParentMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsSettingMacsec a) => O.OverloadedMethod SettingMacsecGetParentMethodInfo a signature where
overloadedMethod = settingMacsecGetParent
instance O.OverloadedMethodInfo SettingMacsecGetParentMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingMacsec.settingMacsecGetParent",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingMacsec.html#v:settingMacsecGetParent"
})
#endif
foreign import ccall "nm_setting_macsec_get_port" nm_setting_macsec_get_port ::
Ptr SettingMacsec ->
IO Int32
settingMacsecGetPort ::
(B.CallStack.HasCallStack, MonadIO m, IsSettingMacsec a) =>
a
-> m Int32
settingMacsecGetPort :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingMacsec a) =>
a -> m Int32
settingMacsecGetPort a
setting = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
Ptr SettingMacsec
setting' <- a -> IO (Ptr SettingMacsec)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
setting
Int32
result <- Ptr SettingMacsec -> IO Int32
nm_setting_macsec_get_port Ptr SettingMacsec
setting'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
setting
Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result
#if defined(ENABLE_OVERLOADING)
data SettingMacsecGetPortMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsSettingMacsec a) => O.OverloadedMethod SettingMacsecGetPortMethodInfo a signature where
overloadedMethod = settingMacsecGetPort
instance O.OverloadedMethodInfo SettingMacsecGetPortMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingMacsec.settingMacsecGetPort",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingMacsec.html#v:settingMacsecGetPort"
})
#endif
foreign import ccall "nm_setting_macsec_get_send_sci" nm_setting_macsec_get_send_sci ::
Ptr SettingMacsec ->
IO CInt
settingMacsecGetSendSci ::
(B.CallStack.HasCallStack, MonadIO m, IsSettingMacsec a) =>
a
-> m Bool
settingMacsecGetSendSci :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingMacsec a) =>
a -> m Bool
settingMacsecGetSendSci a
setting = 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 SettingMacsec
setting' <- a -> IO (Ptr SettingMacsec)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
setting
CInt
result <- Ptr SettingMacsec -> IO CInt
nm_setting_macsec_get_send_sci Ptr SettingMacsec
setting'
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
setting
Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data SettingMacsecGetSendSciMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsSettingMacsec a) => O.OverloadedMethod SettingMacsecGetSendSciMethodInfo a signature where
overloadedMethod = settingMacsecGetSendSci
instance O.OverloadedMethodInfo SettingMacsecGetSendSciMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingMacsec.settingMacsecGetSendSci",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingMacsec.html#v:settingMacsecGetSendSci"
})
#endif
foreign import ccall "nm_setting_macsec_get_validation" nm_setting_macsec_get_validation ::
Ptr SettingMacsec ->
IO CUInt
settingMacsecGetValidation ::
(B.CallStack.HasCallStack, MonadIO m, IsSettingMacsec a) =>
a
-> m NM.Enums.SettingMacsecValidation
settingMacsecGetValidation :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingMacsec a) =>
a -> m SettingMacsecValidation
settingMacsecGetValidation a
setting = IO SettingMacsecValidation -> m SettingMacsecValidation
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SettingMacsecValidation -> m SettingMacsecValidation)
-> IO SettingMacsecValidation -> m SettingMacsecValidation
forall a b. (a -> b) -> a -> b
$ do
Ptr SettingMacsec
setting' <- a -> IO (Ptr SettingMacsec)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
setting
CUInt
result <- Ptr SettingMacsec -> IO CUInt
nm_setting_macsec_get_validation Ptr SettingMacsec
setting'
let result' :: SettingMacsecValidation
result' = (Int -> SettingMacsecValidation
forall a. Enum a => Int -> a
toEnum (Int -> SettingMacsecValidation)
-> (CUInt -> Int) -> CUInt -> SettingMacsecValidation
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
setting
SettingMacsecValidation -> IO SettingMacsecValidation
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SettingMacsecValidation
result'
#if defined(ENABLE_OVERLOADING)
data SettingMacsecGetValidationMethodInfo
instance (signature ~ (m NM.Enums.SettingMacsecValidation), MonadIO m, IsSettingMacsec a) => O.OverloadedMethod SettingMacsecGetValidationMethodInfo a signature where
overloadedMethod = settingMacsecGetValidation
instance O.OverloadedMethodInfo SettingMacsecGetValidationMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingMacsec.settingMacsecGetValidation",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingMacsec.html#v:settingMacsecGetValidation"
})
#endif