{-# LANGUAGE TypeApplications #-}
#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif
module GI.NM.Objects.SettingWireGuard
(
SettingWireGuard(..) ,
IsSettingWireGuard ,
toSettingWireGuard ,
#if defined(ENABLE_OVERLOADING)
ResolveSettingWireGuardMethod ,
#endif
#if defined(ENABLE_OVERLOADING)
SettingWireGuardAppendPeerMethodInfo ,
#endif
settingWireGuardAppendPeer ,
#if defined(ENABLE_OVERLOADING)
SettingWireGuardClearPeersMethodInfo ,
#endif
settingWireGuardClearPeers ,
#if defined(ENABLE_OVERLOADING)
SettingWireGuardGetFwmarkMethodInfo ,
#endif
settingWireGuardGetFwmark ,
#if defined(ENABLE_OVERLOADING)
SettingWireGuardGetIp4AutoDefaultRouteMethodInfo,
#endif
settingWireGuardGetIp4AutoDefaultRoute ,
#if defined(ENABLE_OVERLOADING)
SettingWireGuardGetIp6AutoDefaultRouteMethodInfo,
#endif
settingWireGuardGetIp6AutoDefaultRoute ,
#if defined(ENABLE_OVERLOADING)
SettingWireGuardGetListenPortMethodInfo ,
#endif
settingWireGuardGetListenPort ,
#if defined(ENABLE_OVERLOADING)
SettingWireGuardGetMtuMethodInfo ,
#endif
settingWireGuardGetMtu ,
#if defined(ENABLE_OVERLOADING)
SettingWireGuardGetPeerMethodInfo ,
#endif
settingWireGuardGetPeer ,
#if defined(ENABLE_OVERLOADING)
SettingWireGuardGetPeerByPublicKeyMethodInfo,
#endif
settingWireGuardGetPeerByPublicKey ,
#if defined(ENABLE_OVERLOADING)
SettingWireGuardGetPeerRoutesMethodInfo ,
#endif
settingWireGuardGetPeerRoutes ,
#if defined(ENABLE_OVERLOADING)
SettingWireGuardGetPeersLenMethodInfo ,
#endif
settingWireGuardGetPeersLen ,
#if defined(ENABLE_OVERLOADING)
SettingWireGuardGetPrivateKeyMethodInfo ,
#endif
settingWireGuardGetPrivateKey ,
#if defined(ENABLE_OVERLOADING)
SettingWireGuardGetPrivateKeyFlagsMethodInfo,
#endif
settingWireGuardGetPrivateKeyFlags ,
settingWireGuardNew ,
#if defined(ENABLE_OVERLOADING)
SettingWireGuardRemovePeerMethodInfo ,
#endif
settingWireGuardRemovePeer ,
#if defined(ENABLE_OVERLOADING)
SettingWireGuardSetPeerMethodInfo ,
#endif
settingWireGuardSetPeer ,
#if defined(ENABLE_OVERLOADING)
SettingWireGuardFwmarkPropertyInfo ,
#endif
constructSettingWireGuardFwmark ,
getSettingWireGuardFwmark ,
setSettingWireGuardFwmark ,
#if defined(ENABLE_OVERLOADING)
settingWireGuardFwmark ,
#endif
#if defined(ENABLE_OVERLOADING)
SettingWireGuardIp4AutoDefaultRoutePropertyInfo,
#endif
constructSettingWireGuardIp4AutoDefaultRoute,
getSettingWireGuardIp4AutoDefaultRoute ,
setSettingWireGuardIp4AutoDefaultRoute ,
#if defined(ENABLE_OVERLOADING)
settingWireGuardIp4AutoDefaultRoute ,
#endif
#if defined(ENABLE_OVERLOADING)
SettingWireGuardIp6AutoDefaultRoutePropertyInfo,
#endif
constructSettingWireGuardIp6AutoDefaultRoute,
getSettingWireGuardIp6AutoDefaultRoute ,
setSettingWireGuardIp6AutoDefaultRoute ,
#if defined(ENABLE_OVERLOADING)
settingWireGuardIp6AutoDefaultRoute ,
#endif
#if defined(ENABLE_OVERLOADING)
SettingWireGuardListenPortPropertyInfo ,
#endif
constructSettingWireGuardListenPort ,
getSettingWireGuardListenPort ,
setSettingWireGuardListenPort ,
#if defined(ENABLE_OVERLOADING)
settingWireGuardListenPort ,
#endif
#if defined(ENABLE_OVERLOADING)
SettingWireGuardMtuPropertyInfo ,
#endif
constructSettingWireGuardMtu ,
getSettingWireGuardMtu ,
setSettingWireGuardMtu ,
#if defined(ENABLE_OVERLOADING)
settingWireGuardMtu ,
#endif
#if defined(ENABLE_OVERLOADING)
SettingWireGuardPeerRoutesPropertyInfo ,
#endif
constructSettingWireGuardPeerRoutes ,
getSettingWireGuardPeerRoutes ,
setSettingWireGuardPeerRoutes ,
#if defined(ENABLE_OVERLOADING)
settingWireGuardPeerRoutes ,
#endif
#if defined(ENABLE_OVERLOADING)
SettingWireGuardPrivateKeyPropertyInfo ,
#endif
clearSettingWireGuardPrivateKey ,
constructSettingWireGuardPrivateKey ,
getSettingWireGuardPrivateKey ,
setSettingWireGuardPrivateKey ,
#if defined(ENABLE_OVERLOADING)
settingWireGuardPrivateKey ,
#endif
#if defined(ENABLE_OVERLOADING)
SettingWireGuardPrivateKeyFlagsPropertyInfo,
#endif
constructSettingWireGuardPrivateKeyFlags,
getSettingWireGuardPrivateKeyFlags ,
setSettingWireGuardPrivateKeyFlags ,
#if defined(ENABLE_OVERLOADING)
settingWireGuardPrivateKeyFlags ,
#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.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.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
import {-# SOURCE #-} qualified GI.NM.Structs.WireGuardPeer as NM.WireGuardPeer
#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
import {-# SOURCE #-} qualified GI.NM.Structs.WireGuardPeer as NM.WireGuardPeer
#endif
newtype SettingWireGuard = SettingWireGuard (SP.ManagedPtr SettingWireGuard)
deriving (SettingWireGuard -> SettingWireGuard -> Bool
(SettingWireGuard -> SettingWireGuard -> Bool)
-> (SettingWireGuard -> SettingWireGuard -> Bool)
-> Eq SettingWireGuard
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SettingWireGuard -> SettingWireGuard -> Bool
== :: SettingWireGuard -> SettingWireGuard -> Bool
$c/= :: SettingWireGuard -> SettingWireGuard -> Bool
/= :: SettingWireGuard -> SettingWireGuard -> Bool
Eq)
instance SP.ManagedPtrNewtype SettingWireGuard where
toManagedPtr :: SettingWireGuard -> ManagedPtr SettingWireGuard
toManagedPtr (SettingWireGuard ManagedPtr SettingWireGuard
p) = ManagedPtr SettingWireGuard
p
foreign import ccall "nm_setting_wireguard_get_type"
c_nm_setting_wireguard_get_type :: IO B.Types.GType
instance B.Types.TypedObject SettingWireGuard where
glibType :: IO GType
glibType = IO GType
c_nm_setting_wireguard_get_type
instance B.Types.GObject SettingWireGuard
class (SP.GObject o, O.IsDescendantOf SettingWireGuard o) => IsSettingWireGuard o
instance (SP.GObject o, O.IsDescendantOf SettingWireGuard o) => IsSettingWireGuard o
instance O.HasParentTypes SettingWireGuard
type instance O.ParentTypes SettingWireGuard = '[NM.Setting.Setting, GObject.Object.Object]
toSettingWireGuard :: (MIO.MonadIO m, IsSettingWireGuard o) => o -> m SettingWireGuard
toSettingWireGuard :: forall (m :: * -> *) o.
(MonadIO m, IsSettingWireGuard o) =>
o -> m SettingWireGuard
toSettingWireGuard = IO SettingWireGuard -> m SettingWireGuard
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO SettingWireGuard -> m SettingWireGuard)
-> (o -> IO SettingWireGuard) -> o -> m SettingWireGuard
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr SettingWireGuard -> SettingWireGuard)
-> o -> IO SettingWireGuard
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr SettingWireGuard -> SettingWireGuard
SettingWireGuard
instance B.GValue.IsGValue (Maybe SettingWireGuard) where
gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_nm_setting_wireguard_get_type
gvalueSet_ :: Ptr GValue -> Maybe SettingWireGuard -> IO ()
gvalueSet_ Ptr GValue
gv Maybe SettingWireGuard
P.Nothing = Ptr GValue -> Ptr SettingWireGuard -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr SettingWireGuard
forall a. Ptr a
FP.nullPtr :: FP.Ptr SettingWireGuard)
gvalueSet_ Ptr GValue
gv (P.Just SettingWireGuard
obj) = SettingWireGuard -> (Ptr SettingWireGuard -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr SettingWireGuard
obj (Ptr GValue -> Ptr SettingWireGuard -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
gvalueGet_ :: Ptr GValue -> IO (Maybe SettingWireGuard)
gvalueGet_ Ptr GValue
gv = do
Ptr SettingWireGuard
ptr <- Ptr GValue -> IO (Ptr SettingWireGuard)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr SettingWireGuard)
if Ptr SettingWireGuard
ptr Ptr SettingWireGuard -> Ptr SettingWireGuard -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr SettingWireGuard
forall a. Ptr a
FP.nullPtr
then SettingWireGuard -> Maybe SettingWireGuard
forall a. a -> Maybe a
P.Just (SettingWireGuard -> Maybe SettingWireGuard)
-> IO SettingWireGuard -> IO (Maybe SettingWireGuard)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr SettingWireGuard -> SettingWireGuard)
-> Ptr SettingWireGuard -> IO SettingWireGuard
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr SettingWireGuard -> SettingWireGuard
SettingWireGuard Ptr SettingWireGuard
ptr
else Maybe SettingWireGuard -> IO (Maybe SettingWireGuard)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SettingWireGuard
forall a. Maybe a
P.Nothing
#if defined(ENABLE_OVERLOADING)
type family ResolveSettingWireGuardMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
ResolveSettingWireGuardMethod "appendPeer" o = SettingWireGuardAppendPeerMethodInfo
ResolveSettingWireGuardMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
ResolveSettingWireGuardMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
ResolveSettingWireGuardMethod "clearPeers" o = SettingWireGuardClearPeersMethodInfo
ResolveSettingWireGuardMethod "compare" o = NM.Setting.SettingCompareMethodInfo
ResolveSettingWireGuardMethod "diff" o = NM.Setting.SettingDiffMethodInfo
ResolveSettingWireGuardMethod "duplicate" o = NM.Setting.SettingDuplicateMethodInfo
ResolveSettingWireGuardMethod "enumerateValues" o = NM.Setting.SettingEnumerateValuesMethodInfo
ResolveSettingWireGuardMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
ResolveSettingWireGuardMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
ResolveSettingWireGuardMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
ResolveSettingWireGuardMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
ResolveSettingWireGuardMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
ResolveSettingWireGuardMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
ResolveSettingWireGuardMethod "optionClearByName" o = NM.Setting.SettingOptionClearByNameMethodInfo
ResolveSettingWireGuardMethod "optionGet" o = NM.Setting.SettingOptionGetMethodInfo
ResolveSettingWireGuardMethod "optionGetAllNames" o = NM.Setting.SettingOptionGetAllNamesMethodInfo
ResolveSettingWireGuardMethod "optionGetBoolean" o = NM.Setting.SettingOptionGetBooleanMethodInfo
ResolveSettingWireGuardMethod "optionGetUint32" o = NM.Setting.SettingOptionGetUint32MethodInfo
ResolveSettingWireGuardMethod "optionSet" o = NM.Setting.SettingOptionSetMethodInfo
ResolveSettingWireGuardMethod "optionSetBoolean" o = NM.Setting.SettingOptionSetBooleanMethodInfo
ResolveSettingWireGuardMethod "optionSetUint32" o = NM.Setting.SettingOptionSetUint32MethodInfo
ResolveSettingWireGuardMethod "ref" o = GObject.Object.ObjectRefMethodInfo
ResolveSettingWireGuardMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
ResolveSettingWireGuardMethod "removePeer" o = SettingWireGuardRemovePeerMethodInfo
ResolveSettingWireGuardMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
ResolveSettingWireGuardMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
ResolveSettingWireGuardMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
ResolveSettingWireGuardMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
ResolveSettingWireGuardMethod "toString" o = NM.Setting.SettingToStringMethodInfo
ResolveSettingWireGuardMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
ResolveSettingWireGuardMethod "verify" o = NM.Setting.SettingVerifyMethodInfo
ResolveSettingWireGuardMethod "verifySecrets" o = NM.Setting.SettingVerifySecretsMethodInfo
ResolveSettingWireGuardMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
ResolveSettingWireGuardMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
ResolveSettingWireGuardMethod "getDbusPropertyType" o = NM.Setting.SettingGetDbusPropertyTypeMethodInfo
ResolveSettingWireGuardMethod "getFwmark" o = SettingWireGuardGetFwmarkMethodInfo
ResolveSettingWireGuardMethod "getIp4AutoDefaultRoute" o = SettingWireGuardGetIp4AutoDefaultRouteMethodInfo
ResolveSettingWireGuardMethod "getIp6AutoDefaultRoute" o = SettingWireGuardGetIp6AutoDefaultRouteMethodInfo
ResolveSettingWireGuardMethod "getListenPort" o = SettingWireGuardGetListenPortMethodInfo
ResolveSettingWireGuardMethod "getMtu" o = SettingWireGuardGetMtuMethodInfo
ResolveSettingWireGuardMethod "getName" o = NM.Setting.SettingGetNameMethodInfo
ResolveSettingWireGuardMethod "getPeer" o = SettingWireGuardGetPeerMethodInfo
ResolveSettingWireGuardMethod "getPeerByPublicKey" o = SettingWireGuardGetPeerByPublicKeyMethodInfo
ResolveSettingWireGuardMethod "getPeerRoutes" o = SettingWireGuardGetPeerRoutesMethodInfo
ResolveSettingWireGuardMethod "getPeersLen" o = SettingWireGuardGetPeersLenMethodInfo
ResolveSettingWireGuardMethod "getPrivateKey" o = SettingWireGuardGetPrivateKeyMethodInfo
ResolveSettingWireGuardMethod "getPrivateKeyFlags" o = SettingWireGuardGetPrivateKeyFlagsMethodInfo
ResolveSettingWireGuardMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
ResolveSettingWireGuardMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
ResolveSettingWireGuardMethod "getSecretFlags" o = NM.Setting.SettingGetSecretFlagsMethodInfo
ResolveSettingWireGuardMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
ResolveSettingWireGuardMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
ResolveSettingWireGuardMethod "setPeer" o = SettingWireGuardSetPeerMethodInfo
ResolveSettingWireGuardMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
ResolveSettingWireGuardMethod "setSecretFlags" o = NM.Setting.SettingSetSecretFlagsMethodInfo
ResolveSettingWireGuardMethod l o = O.MethodResolutionFailed l o
instance (info ~ ResolveSettingWireGuardMethod t SettingWireGuard, O.OverloadedMethod info SettingWireGuard p) => OL.IsLabel t (SettingWireGuard -> 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 ~ ResolveSettingWireGuardMethod t SettingWireGuard, O.OverloadedMethod info SettingWireGuard p, R.HasField t SettingWireGuard p) => R.HasField t SettingWireGuard p where
getField = O.overloadedMethod @info
#endif
instance (info ~ ResolveSettingWireGuardMethod t SettingWireGuard, O.OverloadedMethodInfo info SettingWireGuard) => OL.IsLabel t (O.MethodProxy info SettingWireGuard) where
#if MIN_VERSION_base(4,10,0)
fromLabel = O.MethodProxy
#else
fromLabel _ = O.MethodProxy
#endif
#endif
getSettingWireGuardFwmark :: (MonadIO m, IsSettingWireGuard o) => o -> m Word32
getSettingWireGuardFwmark :: forall (m :: * -> *) o.
(MonadIO m, IsSettingWireGuard o) =>
o -> m Word32
getSettingWireGuardFwmark o
obj = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj String
"fwmark"
setSettingWireGuardFwmark :: (MonadIO m, IsSettingWireGuard o) => o -> Word32 -> m ()
setSettingWireGuardFwmark :: forall (m :: * -> *) o.
(MonadIO m, IsSettingWireGuard o) =>
o -> Word32 -> m ()
setSettingWireGuardFwmark o
obj Word32
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
o -> String -> Word32 -> IO ()
forall a. GObject a => a -> String -> Word32 -> IO ()
B.Properties.setObjectPropertyUInt32 o
obj String
"fwmark" Word32
val
constructSettingWireGuardFwmark :: (IsSettingWireGuard o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructSettingWireGuardFwmark :: forall o (m :: * -> *).
(IsSettingWireGuard o, MonadIO m) =>
Word32 -> m (GValueConstruct o)
constructSettingWireGuardFwmark Word32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Word32 -> IO (GValueConstruct o)
forall o. String -> Word32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt32 String
"fwmark" Word32
val
#if defined(ENABLE_OVERLOADING)
data SettingWireGuardFwmarkPropertyInfo
instance AttrInfo SettingWireGuardFwmarkPropertyInfo where
type AttrAllowedOps SettingWireGuardFwmarkPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint SettingWireGuardFwmarkPropertyInfo = IsSettingWireGuard
type AttrSetTypeConstraint SettingWireGuardFwmarkPropertyInfo = (~) Word32
type AttrTransferTypeConstraint SettingWireGuardFwmarkPropertyInfo = (~) Word32
type AttrTransferType SettingWireGuardFwmarkPropertyInfo = Word32
type AttrGetType SettingWireGuardFwmarkPropertyInfo = Word32
type AttrLabel SettingWireGuardFwmarkPropertyInfo = "fwmark"
type AttrOrigin SettingWireGuardFwmarkPropertyInfo = SettingWireGuard
attrGet = getSettingWireGuardFwmark
attrSet = setSettingWireGuardFwmark
attrTransfer _ v = do
return v
attrConstruct = constructSettingWireGuardFwmark
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingWireGuard.fwmark"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingWireGuard.html#g:attr:fwmark"
})
#endif
getSettingWireGuardIp4AutoDefaultRoute :: (MonadIO m, IsSettingWireGuard o) => o -> m NM.Enums.Ternary
getSettingWireGuardIp4AutoDefaultRoute :: forall (m :: * -> *) o.
(MonadIO m, IsSettingWireGuard o) =>
o -> m Ternary
getSettingWireGuardIp4AutoDefaultRoute o
obj = IO Ternary -> m Ternary
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Ternary -> m Ternary) -> IO Ternary -> m Ternary
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Ternary
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"ip4-auto-default-route"
setSettingWireGuardIp4AutoDefaultRoute :: (MonadIO m, IsSettingWireGuard o) => o -> NM.Enums.Ternary -> m ()
setSettingWireGuardIp4AutoDefaultRoute :: forall (m :: * -> *) o.
(MonadIO m, IsSettingWireGuard o) =>
o -> Ternary -> m ()
setSettingWireGuardIp4AutoDefaultRoute o
obj Ternary
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 -> Ternary -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj String
"ip4-auto-default-route" Ternary
val
constructSettingWireGuardIp4AutoDefaultRoute :: (IsSettingWireGuard o, MIO.MonadIO m) => NM.Enums.Ternary -> m (GValueConstruct o)
constructSettingWireGuardIp4AutoDefaultRoute :: forall o (m :: * -> *).
(IsSettingWireGuard o, MonadIO m) =>
Ternary -> m (GValueConstruct o)
constructSettingWireGuardIp4AutoDefaultRoute Ternary
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 -> Ternary -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"ip4-auto-default-route" Ternary
val
#if defined(ENABLE_OVERLOADING)
data SettingWireGuardIp4AutoDefaultRoutePropertyInfo
instance AttrInfo SettingWireGuardIp4AutoDefaultRoutePropertyInfo where
type AttrAllowedOps SettingWireGuardIp4AutoDefaultRoutePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint SettingWireGuardIp4AutoDefaultRoutePropertyInfo = IsSettingWireGuard
type AttrSetTypeConstraint SettingWireGuardIp4AutoDefaultRoutePropertyInfo = (~) NM.Enums.Ternary
type AttrTransferTypeConstraint SettingWireGuardIp4AutoDefaultRoutePropertyInfo = (~) NM.Enums.Ternary
type AttrTransferType SettingWireGuardIp4AutoDefaultRoutePropertyInfo = NM.Enums.Ternary
type AttrGetType SettingWireGuardIp4AutoDefaultRoutePropertyInfo = NM.Enums.Ternary
type AttrLabel SettingWireGuardIp4AutoDefaultRoutePropertyInfo = "ip4-auto-default-route"
type AttrOrigin SettingWireGuardIp4AutoDefaultRoutePropertyInfo = SettingWireGuard
attrGet = getSettingWireGuardIp4AutoDefaultRoute
attrSet = setSettingWireGuardIp4AutoDefaultRoute
attrTransfer _ v = do
return v
attrConstruct = constructSettingWireGuardIp4AutoDefaultRoute
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingWireGuard.ip4AutoDefaultRoute"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingWireGuard.html#g:attr:ip4AutoDefaultRoute"
})
#endif
getSettingWireGuardIp6AutoDefaultRoute :: (MonadIO m, IsSettingWireGuard o) => o -> m NM.Enums.Ternary
getSettingWireGuardIp6AutoDefaultRoute :: forall (m :: * -> *) o.
(MonadIO m, IsSettingWireGuard o) =>
o -> m Ternary
getSettingWireGuardIp6AutoDefaultRoute o
obj = IO Ternary -> m Ternary
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Ternary -> m Ternary) -> IO Ternary -> m Ternary
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Ternary
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"ip6-auto-default-route"
setSettingWireGuardIp6AutoDefaultRoute :: (MonadIO m, IsSettingWireGuard o) => o -> NM.Enums.Ternary -> m ()
setSettingWireGuardIp6AutoDefaultRoute :: forall (m :: * -> *) o.
(MonadIO m, IsSettingWireGuard o) =>
o -> Ternary -> m ()
setSettingWireGuardIp6AutoDefaultRoute o
obj Ternary
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 -> Ternary -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj String
"ip6-auto-default-route" Ternary
val
constructSettingWireGuardIp6AutoDefaultRoute :: (IsSettingWireGuard o, MIO.MonadIO m) => NM.Enums.Ternary -> m (GValueConstruct o)
constructSettingWireGuardIp6AutoDefaultRoute :: forall o (m :: * -> *).
(IsSettingWireGuard o, MonadIO m) =>
Ternary -> m (GValueConstruct o)
constructSettingWireGuardIp6AutoDefaultRoute Ternary
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 -> Ternary -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"ip6-auto-default-route" Ternary
val
#if defined(ENABLE_OVERLOADING)
data SettingWireGuardIp6AutoDefaultRoutePropertyInfo
instance AttrInfo SettingWireGuardIp6AutoDefaultRoutePropertyInfo where
type AttrAllowedOps SettingWireGuardIp6AutoDefaultRoutePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint SettingWireGuardIp6AutoDefaultRoutePropertyInfo = IsSettingWireGuard
type AttrSetTypeConstraint SettingWireGuardIp6AutoDefaultRoutePropertyInfo = (~) NM.Enums.Ternary
type AttrTransferTypeConstraint SettingWireGuardIp6AutoDefaultRoutePropertyInfo = (~) NM.Enums.Ternary
type AttrTransferType SettingWireGuardIp6AutoDefaultRoutePropertyInfo = NM.Enums.Ternary
type AttrGetType SettingWireGuardIp6AutoDefaultRoutePropertyInfo = NM.Enums.Ternary
type AttrLabel SettingWireGuardIp6AutoDefaultRoutePropertyInfo = "ip6-auto-default-route"
type AttrOrigin SettingWireGuardIp6AutoDefaultRoutePropertyInfo = SettingWireGuard
attrGet = getSettingWireGuardIp6AutoDefaultRoute
attrSet = setSettingWireGuardIp6AutoDefaultRoute
attrTransfer _ v = do
return v
attrConstruct = constructSettingWireGuardIp6AutoDefaultRoute
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingWireGuard.ip6AutoDefaultRoute"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingWireGuard.html#g:attr:ip6AutoDefaultRoute"
})
#endif
getSettingWireGuardListenPort :: (MonadIO m, IsSettingWireGuard o) => o -> m Word32
getSettingWireGuardListenPort :: forall (m :: * -> *) o.
(MonadIO m, IsSettingWireGuard o) =>
o -> m Word32
getSettingWireGuardListenPort 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
"listen-port"
setSettingWireGuardListenPort :: (MonadIO m, IsSettingWireGuard o) => o -> Word32 -> m ()
setSettingWireGuardListenPort :: forall (m :: * -> *) o.
(MonadIO m, IsSettingWireGuard o) =>
o -> Word32 -> m ()
setSettingWireGuardListenPort o
obj Word32
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
o -> String -> Word32 -> IO ()
forall a. GObject a => a -> String -> Word32 -> IO ()
B.Properties.setObjectPropertyUInt32 o
obj String
"listen-port" Word32
val
constructSettingWireGuardListenPort :: (IsSettingWireGuard o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructSettingWireGuardListenPort :: forall o (m :: * -> *).
(IsSettingWireGuard o, MonadIO m) =>
Word32 -> m (GValueConstruct o)
constructSettingWireGuardListenPort Word32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Word32 -> IO (GValueConstruct o)
forall o. String -> Word32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt32 String
"listen-port" Word32
val
#if defined(ENABLE_OVERLOADING)
data SettingWireGuardListenPortPropertyInfo
instance AttrInfo SettingWireGuardListenPortPropertyInfo where
type AttrAllowedOps SettingWireGuardListenPortPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint SettingWireGuardListenPortPropertyInfo = IsSettingWireGuard
type AttrSetTypeConstraint SettingWireGuardListenPortPropertyInfo = (~) Word32
type AttrTransferTypeConstraint SettingWireGuardListenPortPropertyInfo = (~) Word32
type AttrTransferType SettingWireGuardListenPortPropertyInfo = Word32
type AttrGetType SettingWireGuardListenPortPropertyInfo = Word32
type AttrLabel SettingWireGuardListenPortPropertyInfo = "listen-port"
type AttrOrigin SettingWireGuardListenPortPropertyInfo = SettingWireGuard
attrGet = getSettingWireGuardListenPort
attrSet = setSettingWireGuardListenPort
attrTransfer _ v = do
return v
attrConstruct = constructSettingWireGuardListenPort
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingWireGuard.listenPort"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingWireGuard.html#g:attr:listenPort"
})
#endif
getSettingWireGuardMtu :: (MonadIO m, IsSettingWireGuard o) => o -> m Word32
getSettingWireGuardMtu :: forall (m :: * -> *) o.
(MonadIO m, IsSettingWireGuard o) =>
o -> m Word32
getSettingWireGuardMtu 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
"mtu"
setSettingWireGuardMtu :: (MonadIO m, IsSettingWireGuard o) => o -> Word32 -> m ()
setSettingWireGuardMtu :: forall (m :: * -> *) o.
(MonadIO m, IsSettingWireGuard o) =>
o -> Word32 -> m ()
setSettingWireGuardMtu o
obj Word32
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
o -> String -> Word32 -> IO ()
forall a. GObject a => a -> String -> Word32 -> IO ()
B.Properties.setObjectPropertyUInt32 o
obj String
"mtu" Word32
val
constructSettingWireGuardMtu :: (IsSettingWireGuard o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructSettingWireGuardMtu :: forall o (m :: * -> *).
(IsSettingWireGuard o, MonadIO m) =>
Word32 -> m (GValueConstruct o)
constructSettingWireGuardMtu Word32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Word32 -> IO (GValueConstruct o)
forall o. String -> Word32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt32 String
"mtu" Word32
val
#if defined(ENABLE_OVERLOADING)
data SettingWireGuardMtuPropertyInfo
instance AttrInfo SettingWireGuardMtuPropertyInfo where
type AttrAllowedOps SettingWireGuardMtuPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint SettingWireGuardMtuPropertyInfo = IsSettingWireGuard
type AttrSetTypeConstraint SettingWireGuardMtuPropertyInfo = (~) Word32
type AttrTransferTypeConstraint SettingWireGuardMtuPropertyInfo = (~) Word32
type AttrTransferType SettingWireGuardMtuPropertyInfo = Word32
type AttrGetType SettingWireGuardMtuPropertyInfo = Word32
type AttrLabel SettingWireGuardMtuPropertyInfo = "mtu"
type AttrOrigin SettingWireGuardMtuPropertyInfo = SettingWireGuard
attrGet = getSettingWireGuardMtu
attrSet = setSettingWireGuardMtu
attrTransfer _ v = do
return v
attrConstruct = constructSettingWireGuardMtu
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingWireGuard.mtu"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingWireGuard.html#g:attr:mtu"
})
#endif
getSettingWireGuardPeerRoutes :: (MonadIO m, IsSettingWireGuard o) => o -> m Bool
getSettingWireGuardPeerRoutes :: forall (m :: * -> *) o.
(MonadIO m, IsSettingWireGuard o) =>
o -> m Bool
getSettingWireGuardPeerRoutes 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
"peer-routes"
setSettingWireGuardPeerRoutes :: (MonadIO m, IsSettingWireGuard o) => o -> Bool -> m ()
setSettingWireGuardPeerRoutes :: forall (m :: * -> *) o.
(MonadIO m, IsSettingWireGuard o) =>
o -> Bool -> m ()
setSettingWireGuardPeerRoutes 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
"peer-routes" Bool
val
constructSettingWireGuardPeerRoutes :: (IsSettingWireGuard o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructSettingWireGuardPeerRoutes :: forall o (m :: * -> *).
(IsSettingWireGuard o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructSettingWireGuardPeerRoutes 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
"peer-routes" Bool
val
#if defined(ENABLE_OVERLOADING)
data SettingWireGuardPeerRoutesPropertyInfo
instance AttrInfo SettingWireGuardPeerRoutesPropertyInfo where
type AttrAllowedOps SettingWireGuardPeerRoutesPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint SettingWireGuardPeerRoutesPropertyInfo = IsSettingWireGuard
type AttrSetTypeConstraint SettingWireGuardPeerRoutesPropertyInfo = (~) Bool
type AttrTransferTypeConstraint SettingWireGuardPeerRoutesPropertyInfo = (~) Bool
type AttrTransferType SettingWireGuardPeerRoutesPropertyInfo = Bool
type AttrGetType SettingWireGuardPeerRoutesPropertyInfo = Bool
type AttrLabel SettingWireGuardPeerRoutesPropertyInfo = "peer-routes"
type AttrOrigin SettingWireGuardPeerRoutesPropertyInfo = SettingWireGuard
attrGet = getSettingWireGuardPeerRoutes
attrSet = setSettingWireGuardPeerRoutes
attrTransfer _ v = do
return v
attrConstruct = constructSettingWireGuardPeerRoutes
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingWireGuard.peerRoutes"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingWireGuard.html#g:attr:peerRoutes"
})
#endif
getSettingWireGuardPrivateKey :: (MonadIO m, IsSettingWireGuard o) => o -> m T.Text
getSettingWireGuardPrivateKey :: forall (m :: * -> *) o.
(MonadIO m, IsSettingWireGuard o) =>
o -> m Text
getSettingWireGuardPrivateKey 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
"getSettingWireGuardPrivateKey" (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
"private-key"
setSettingWireGuardPrivateKey :: (MonadIO m, IsSettingWireGuard o) => o -> T.Text -> m ()
setSettingWireGuardPrivateKey :: forall (m :: * -> *) o.
(MonadIO m, IsSettingWireGuard o) =>
o -> Text -> m ()
setSettingWireGuardPrivateKey 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
"private-key" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)
constructSettingWireGuardPrivateKey :: (IsSettingWireGuard o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructSettingWireGuardPrivateKey :: forall o (m :: * -> *).
(IsSettingWireGuard o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructSettingWireGuardPrivateKey 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
"private-key" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)
clearSettingWireGuardPrivateKey :: (MonadIO m, IsSettingWireGuard o) => o -> m ()
clearSettingWireGuardPrivateKey :: forall (m :: * -> *) o.
(MonadIO m, IsSettingWireGuard o) =>
o -> m ()
clearSettingWireGuardPrivateKey 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
"private-key" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)
#if defined(ENABLE_OVERLOADING)
data SettingWireGuardPrivateKeyPropertyInfo
instance AttrInfo SettingWireGuardPrivateKeyPropertyInfo where
type AttrAllowedOps SettingWireGuardPrivateKeyPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint SettingWireGuardPrivateKeyPropertyInfo = IsSettingWireGuard
type AttrSetTypeConstraint SettingWireGuardPrivateKeyPropertyInfo = (~) T.Text
type AttrTransferTypeConstraint SettingWireGuardPrivateKeyPropertyInfo = (~) T.Text
type AttrTransferType SettingWireGuardPrivateKeyPropertyInfo = T.Text
type AttrGetType SettingWireGuardPrivateKeyPropertyInfo = T.Text
type AttrLabel SettingWireGuardPrivateKeyPropertyInfo = "private-key"
type AttrOrigin SettingWireGuardPrivateKeyPropertyInfo = SettingWireGuard
attrGet = getSettingWireGuardPrivateKey
attrSet = setSettingWireGuardPrivateKey
attrTransfer _ v = do
return v
attrConstruct = constructSettingWireGuardPrivateKey
attrClear = clearSettingWireGuardPrivateKey
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingWireGuard.privateKey"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingWireGuard.html#g:attr:privateKey"
})
#endif
getSettingWireGuardPrivateKeyFlags :: (MonadIO m, IsSettingWireGuard o) => o -> m [NM.Flags.SettingSecretFlags]
getSettingWireGuardPrivateKeyFlags :: forall (m :: * -> *) o.
(MonadIO m, IsSettingWireGuard o) =>
o -> m [SettingSecretFlags]
getSettingWireGuardPrivateKeyFlags 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
"private-key-flags"
setSettingWireGuardPrivateKeyFlags :: (MonadIO m, IsSettingWireGuard o) => o -> [NM.Flags.SettingSecretFlags] -> m ()
setSettingWireGuardPrivateKeyFlags :: forall (m :: * -> *) o.
(MonadIO m, IsSettingWireGuard o) =>
o -> [SettingSecretFlags] -> m ()
setSettingWireGuardPrivateKeyFlags 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
"private-key-flags" [SettingSecretFlags]
val
constructSettingWireGuardPrivateKeyFlags :: (IsSettingWireGuard o, MIO.MonadIO m) => [NM.Flags.SettingSecretFlags] -> m (GValueConstruct o)
constructSettingWireGuardPrivateKeyFlags :: forall o (m :: * -> *).
(IsSettingWireGuard o, MonadIO m) =>
[SettingSecretFlags] -> m (GValueConstruct o)
constructSettingWireGuardPrivateKeyFlags [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
"private-key-flags" [SettingSecretFlags]
val
#if defined(ENABLE_OVERLOADING)
data SettingWireGuardPrivateKeyFlagsPropertyInfo
instance AttrInfo SettingWireGuardPrivateKeyFlagsPropertyInfo where
type AttrAllowedOps SettingWireGuardPrivateKeyFlagsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint SettingWireGuardPrivateKeyFlagsPropertyInfo = IsSettingWireGuard
type AttrSetTypeConstraint SettingWireGuardPrivateKeyFlagsPropertyInfo = (~) [NM.Flags.SettingSecretFlags]
type AttrTransferTypeConstraint SettingWireGuardPrivateKeyFlagsPropertyInfo = (~) [NM.Flags.SettingSecretFlags]
type AttrTransferType SettingWireGuardPrivateKeyFlagsPropertyInfo = [NM.Flags.SettingSecretFlags]
type AttrGetType SettingWireGuardPrivateKeyFlagsPropertyInfo = [NM.Flags.SettingSecretFlags]
type AttrLabel SettingWireGuardPrivateKeyFlagsPropertyInfo = "private-key-flags"
type AttrOrigin SettingWireGuardPrivateKeyFlagsPropertyInfo = SettingWireGuard
attrGet = getSettingWireGuardPrivateKeyFlags
attrSet = setSettingWireGuardPrivateKeyFlags
attrTransfer _ v = do
return v
attrConstruct = constructSettingWireGuardPrivateKeyFlags
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingWireGuard.privateKeyFlags"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingWireGuard.html#g:attr:privateKeyFlags"
})
#endif
#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList SettingWireGuard
type instance O.AttributeList SettingWireGuard = SettingWireGuardAttributeList
type SettingWireGuardAttributeList = ('[ '("fwmark", SettingWireGuardFwmarkPropertyInfo), '("ip4AutoDefaultRoute", SettingWireGuardIp4AutoDefaultRoutePropertyInfo), '("ip6AutoDefaultRoute", SettingWireGuardIp6AutoDefaultRoutePropertyInfo), '("listenPort", SettingWireGuardListenPortPropertyInfo), '("mtu", SettingWireGuardMtuPropertyInfo), '("name", NM.Setting.SettingNamePropertyInfo), '("peerRoutes", SettingWireGuardPeerRoutesPropertyInfo), '("privateKey", SettingWireGuardPrivateKeyPropertyInfo), '("privateKeyFlags", SettingWireGuardPrivateKeyFlagsPropertyInfo)] :: [(Symbol, DK.Type)])
#endif
#if defined(ENABLE_OVERLOADING)
settingWireGuardFwmark :: AttrLabelProxy "fwmark"
settingWireGuardFwmark = AttrLabelProxy
settingWireGuardIp4AutoDefaultRoute :: AttrLabelProxy "ip4AutoDefaultRoute"
settingWireGuardIp4AutoDefaultRoute = AttrLabelProxy
settingWireGuardIp6AutoDefaultRoute :: AttrLabelProxy "ip6AutoDefaultRoute"
settingWireGuardIp6AutoDefaultRoute = AttrLabelProxy
settingWireGuardListenPort :: AttrLabelProxy "listenPort"
settingWireGuardListenPort = AttrLabelProxy
settingWireGuardMtu :: AttrLabelProxy "mtu"
settingWireGuardMtu = AttrLabelProxy
settingWireGuardPeerRoutes :: AttrLabelProxy "peerRoutes"
settingWireGuardPeerRoutes = AttrLabelProxy
settingWireGuardPrivateKey :: AttrLabelProxy "privateKey"
settingWireGuardPrivateKey = AttrLabelProxy
settingWireGuardPrivateKeyFlags :: AttrLabelProxy "privateKeyFlags"
settingWireGuardPrivateKeyFlags = AttrLabelProxy
#endif
#if defined(ENABLE_OVERLOADING)
type instance O.SignalList SettingWireGuard = SettingWireGuardSignalList
type SettingWireGuardSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])
#endif
foreign import ccall "nm_setting_wireguard_new" nm_setting_wireguard_new ::
IO (Ptr SettingWireGuard)
settingWireGuardNew ::
(B.CallStack.HasCallStack, MonadIO m) =>
m SettingWireGuard
settingWireGuardNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
m SettingWireGuard
settingWireGuardNew = IO SettingWireGuard -> m SettingWireGuard
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SettingWireGuard -> m SettingWireGuard)
-> IO SettingWireGuard -> m SettingWireGuard
forall a b. (a -> b) -> a -> b
$ do
Ptr SettingWireGuard
result <- IO (Ptr SettingWireGuard)
nm_setting_wireguard_new
Text -> Ptr SettingWireGuard -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"settingWireGuardNew" Ptr SettingWireGuard
result
SettingWireGuard
result' <- ((ManagedPtr SettingWireGuard -> SettingWireGuard)
-> Ptr SettingWireGuard -> IO SettingWireGuard
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr SettingWireGuard -> SettingWireGuard
SettingWireGuard) Ptr SettingWireGuard
result
SettingWireGuard -> IO SettingWireGuard
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SettingWireGuard
result'
#if defined(ENABLE_OVERLOADING)
#endif
foreign import ccall "nm_setting_wireguard_append_peer" nm_setting_wireguard_append_peer ::
Ptr SettingWireGuard ->
Ptr NM.WireGuardPeer.WireGuardPeer ->
IO ()
settingWireGuardAppendPeer ::
(B.CallStack.HasCallStack, MonadIO m, IsSettingWireGuard a) =>
a
-> NM.WireGuardPeer.WireGuardPeer
-> m ()
settingWireGuardAppendPeer :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingWireGuard a) =>
a -> WireGuardPeer -> m ()
settingWireGuardAppendPeer a
self WireGuardPeer
peer = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr SettingWireGuard
self' <- a -> IO (Ptr SettingWireGuard)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
Ptr WireGuardPeer
peer' <- WireGuardPeer -> IO (Ptr WireGuardPeer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WireGuardPeer
peer
Ptr SettingWireGuard -> Ptr WireGuardPeer -> IO ()
nm_setting_wireguard_append_peer Ptr SettingWireGuard
self' Ptr WireGuardPeer
peer'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
WireGuardPeer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WireGuardPeer
peer
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data SettingWireGuardAppendPeerMethodInfo
instance (signature ~ (NM.WireGuardPeer.WireGuardPeer -> m ()), MonadIO m, IsSettingWireGuard a) => O.OverloadedMethod SettingWireGuardAppendPeerMethodInfo a signature where
overloadedMethod = settingWireGuardAppendPeer
instance O.OverloadedMethodInfo SettingWireGuardAppendPeerMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingWireGuard.settingWireGuardAppendPeer",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingWireGuard.html#v:settingWireGuardAppendPeer"
})
#endif
foreign import ccall "nm_setting_wireguard_clear_peers" nm_setting_wireguard_clear_peers ::
Ptr SettingWireGuard ->
IO Word32
settingWireGuardClearPeers ::
(B.CallStack.HasCallStack, MonadIO m, IsSettingWireGuard a) =>
a
-> m Word32
settingWireGuardClearPeers :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingWireGuard a) =>
a -> m Word32
settingWireGuardClearPeers a
self = 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 SettingWireGuard
self' <- a -> IO (Ptr SettingWireGuard)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
Word32
result <- Ptr SettingWireGuard -> IO Word32
nm_setting_wireguard_clear_peers Ptr SettingWireGuard
self'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result
#if defined(ENABLE_OVERLOADING)
data SettingWireGuardClearPeersMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsSettingWireGuard a) => O.OverloadedMethod SettingWireGuardClearPeersMethodInfo a signature where
overloadedMethod = settingWireGuardClearPeers
instance O.OverloadedMethodInfo SettingWireGuardClearPeersMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingWireGuard.settingWireGuardClearPeers",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingWireGuard.html#v:settingWireGuardClearPeers"
})
#endif
foreign import ccall "nm_setting_wireguard_get_fwmark" nm_setting_wireguard_get_fwmark ::
Ptr SettingWireGuard ->
IO Word32
settingWireGuardGetFwmark ::
(B.CallStack.HasCallStack, MonadIO m, IsSettingWireGuard a) =>
a
-> m Word32
settingWireGuardGetFwmark :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingWireGuard a) =>
a -> m Word32
settingWireGuardGetFwmark a
self = 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 SettingWireGuard
self' <- a -> IO (Ptr SettingWireGuard)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
Word32
result <- Ptr SettingWireGuard -> IO Word32
nm_setting_wireguard_get_fwmark Ptr SettingWireGuard
self'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result
#if defined(ENABLE_OVERLOADING)
data SettingWireGuardGetFwmarkMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsSettingWireGuard a) => O.OverloadedMethod SettingWireGuardGetFwmarkMethodInfo a signature where
overloadedMethod = settingWireGuardGetFwmark
instance O.OverloadedMethodInfo SettingWireGuardGetFwmarkMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingWireGuard.settingWireGuardGetFwmark",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingWireGuard.html#v:settingWireGuardGetFwmark"
})
#endif
foreign import ccall "nm_setting_wireguard_get_ip4_auto_default_route" nm_setting_wireguard_get_ip4_auto_default_route ::
Ptr SettingWireGuard ->
IO CInt
settingWireGuardGetIp4AutoDefaultRoute ::
(B.CallStack.HasCallStack, MonadIO m, IsSettingWireGuard a) =>
a
-> m NM.Enums.Ternary
settingWireGuardGetIp4AutoDefaultRoute :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingWireGuard a) =>
a -> m Ternary
settingWireGuardGetIp4AutoDefaultRoute a
self = IO Ternary -> m Ternary
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Ternary -> m Ternary) -> IO Ternary -> m Ternary
forall a b. (a -> b) -> a -> b
$ do
Ptr SettingWireGuard
self' <- a -> IO (Ptr SettingWireGuard)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
CInt
result <- Ptr SettingWireGuard -> IO CInt
nm_setting_wireguard_get_ip4_auto_default_route Ptr SettingWireGuard
self'
let result' :: Ternary
result' = (Int -> Ternary
forall a. Enum a => Int -> a
toEnum (Int -> Ternary) -> (CInt -> Int) -> CInt -> Ternary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CInt
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
Ternary -> IO Ternary
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ternary
result'
#if defined(ENABLE_OVERLOADING)
data SettingWireGuardGetIp4AutoDefaultRouteMethodInfo
instance (signature ~ (m NM.Enums.Ternary), MonadIO m, IsSettingWireGuard a) => O.OverloadedMethod SettingWireGuardGetIp4AutoDefaultRouteMethodInfo a signature where
overloadedMethod = settingWireGuardGetIp4AutoDefaultRoute
instance O.OverloadedMethodInfo SettingWireGuardGetIp4AutoDefaultRouteMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingWireGuard.settingWireGuardGetIp4AutoDefaultRoute",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingWireGuard.html#v:settingWireGuardGetIp4AutoDefaultRoute"
})
#endif
foreign import ccall "nm_setting_wireguard_get_ip6_auto_default_route" nm_setting_wireguard_get_ip6_auto_default_route ::
Ptr SettingWireGuard ->
IO CInt
settingWireGuardGetIp6AutoDefaultRoute ::
(B.CallStack.HasCallStack, MonadIO m, IsSettingWireGuard a) =>
a
-> m NM.Enums.Ternary
settingWireGuardGetIp6AutoDefaultRoute :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingWireGuard a) =>
a -> m Ternary
settingWireGuardGetIp6AutoDefaultRoute a
self = IO Ternary -> m Ternary
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Ternary -> m Ternary) -> IO Ternary -> m Ternary
forall a b. (a -> b) -> a -> b
$ do
Ptr SettingWireGuard
self' <- a -> IO (Ptr SettingWireGuard)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
CInt
result <- Ptr SettingWireGuard -> IO CInt
nm_setting_wireguard_get_ip6_auto_default_route Ptr SettingWireGuard
self'
let result' :: Ternary
result' = (Int -> Ternary
forall a. Enum a => Int -> a
toEnum (Int -> Ternary) -> (CInt -> Int) -> CInt -> Ternary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CInt
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
Ternary -> IO Ternary
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ternary
result'
#if defined(ENABLE_OVERLOADING)
data SettingWireGuardGetIp6AutoDefaultRouteMethodInfo
instance (signature ~ (m NM.Enums.Ternary), MonadIO m, IsSettingWireGuard a) => O.OverloadedMethod SettingWireGuardGetIp6AutoDefaultRouteMethodInfo a signature where
overloadedMethod = settingWireGuardGetIp6AutoDefaultRoute
instance O.OverloadedMethodInfo SettingWireGuardGetIp6AutoDefaultRouteMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingWireGuard.settingWireGuardGetIp6AutoDefaultRoute",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingWireGuard.html#v:settingWireGuardGetIp6AutoDefaultRoute"
})
#endif
foreign import ccall "nm_setting_wireguard_get_listen_port" nm_setting_wireguard_get_listen_port ::
Ptr SettingWireGuard ->
IO Word16
settingWireGuardGetListenPort ::
(B.CallStack.HasCallStack, MonadIO m, IsSettingWireGuard a) =>
a
-> m Word16
settingWireGuardGetListenPort :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingWireGuard a) =>
a -> m Word16
settingWireGuardGetListenPort a
self = IO Word16 -> m Word16
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word16 -> m Word16) -> IO Word16 -> m Word16
forall a b. (a -> b) -> a -> b
$ do
Ptr SettingWireGuard
self' <- a -> IO (Ptr SettingWireGuard)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
Word16
result <- Ptr SettingWireGuard -> IO Word16
nm_setting_wireguard_get_listen_port Ptr SettingWireGuard
self'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
Word16 -> IO Word16
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word16
result
#if defined(ENABLE_OVERLOADING)
data SettingWireGuardGetListenPortMethodInfo
instance (signature ~ (m Word16), MonadIO m, IsSettingWireGuard a) => O.OverloadedMethod SettingWireGuardGetListenPortMethodInfo a signature where
overloadedMethod = settingWireGuardGetListenPort
instance O.OverloadedMethodInfo SettingWireGuardGetListenPortMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingWireGuard.settingWireGuardGetListenPort",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingWireGuard.html#v:settingWireGuardGetListenPort"
})
#endif
foreign import ccall "nm_setting_wireguard_get_mtu" nm_setting_wireguard_get_mtu ::
Ptr SettingWireGuard ->
IO Word32
settingWireGuardGetMtu ::
(B.CallStack.HasCallStack, MonadIO m, IsSettingWireGuard a) =>
a
-> m Word32
settingWireGuardGetMtu :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingWireGuard a) =>
a -> m Word32
settingWireGuardGetMtu a
self = 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 SettingWireGuard
self' <- a -> IO (Ptr SettingWireGuard)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
Word32
result <- Ptr SettingWireGuard -> IO Word32
nm_setting_wireguard_get_mtu Ptr SettingWireGuard
self'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result
#if defined(ENABLE_OVERLOADING)
data SettingWireGuardGetMtuMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsSettingWireGuard a) => O.OverloadedMethod SettingWireGuardGetMtuMethodInfo a signature where
overloadedMethod = settingWireGuardGetMtu
instance O.OverloadedMethodInfo SettingWireGuardGetMtuMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingWireGuard.settingWireGuardGetMtu",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingWireGuard.html#v:settingWireGuardGetMtu"
})
#endif
foreign import ccall "nm_setting_wireguard_get_peer" nm_setting_wireguard_get_peer ::
Ptr SettingWireGuard ->
Word32 ->
IO (Ptr NM.WireGuardPeer.WireGuardPeer)
settingWireGuardGetPeer ::
(B.CallStack.HasCallStack, MonadIO m, IsSettingWireGuard a) =>
a
-> Word32
-> m NM.WireGuardPeer.WireGuardPeer
settingWireGuardGetPeer :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingWireGuard a) =>
a -> Word32 -> m WireGuardPeer
settingWireGuardGetPeer a
self Word32
idx = IO WireGuardPeer -> m WireGuardPeer
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO WireGuardPeer -> m WireGuardPeer)
-> IO WireGuardPeer -> m WireGuardPeer
forall a b. (a -> b) -> a -> b
$ do
Ptr SettingWireGuard
self' <- a -> IO (Ptr SettingWireGuard)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
Ptr WireGuardPeer
result <- Ptr SettingWireGuard -> Word32 -> IO (Ptr WireGuardPeer)
nm_setting_wireguard_get_peer Ptr SettingWireGuard
self' Word32
idx
Text -> Ptr WireGuardPeer -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"settingWireGuardGetPeer" Ptr WireGuardPeer
result
WireGuardPeer
result' <- ((ManagedPtr WireGuardPeer -> WireGuardPeer)
-> Ptr WireGuardPeer -> IO WireGuardPeer
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr WireGuardPeer -> WireGuardPeer
NM.WireGuardPeer.WireGuardPeer) Ptr WireGuardPeer
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
WireGuardPeer -> IO WireGuardPeer
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return WireGuardPeer
result'
#if defined(ENABLE_OVERLOADING)
data SettingWireGuardGetPeerMethodInfo
instance (signature ~ (Word32 -> m NM.WireGuardPeer.WireGuardPeer), MonadIO m, IsSettingWireGuard a) => O.OverloadedMethod SettingWireGuardGetPeerMethodInfo a signature where
overloadedMethod = settingWireGuardGetPeer
instance O.OverloadedMethodInfo SettingWireGuardGetPeerMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingWireGuard.settingWireGuardGetPeer",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingWireGuard.html#v:settingWireGuardGetPeer"
})
#endif
foreign import ccall "nm_setting_wireguard_get_peer_by_public_key" nm_setting_wireguard_get_peer_by_public_key ::
Ptr SettingWireGuard ->
CString ->
Ptr Word32 ->
IO (Ptr NM.WireGuardPeer.WireGuardPeer)
settingWireGuardGetPeerByPublicKey ::
(B.CallStack.HasCallStack, MonadIO m, IsSettingWireGuard a) =>
a
-> T.Text
-> m ((Maybe NM.WireGuardPeer.WireGuardPeer, Word32))
settingWireGuardGetPeerByPublicKey :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingWireGuard a) =>
a -> Text -> m (Maybe WireGuardPeer, Word32)
settingWireGuardGetPeerByPublicKey a
self Text
publicKey = IO (Maybe WireGuardPeer, Word32) -> m (Maybe WireGuardPeer, Word32)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe WireGuardPeer, Word32)
-> m (Maybe WireGuardPeer, Word32))
-> IO (Maybe WireGuardPeer, Word32)
-> m (Maybe WireGuardPeer, Word32)
forall a b. (a -> b) -> a -> b
$ do
Ptr SettingWireGuard
self' <- a -> IO (Ptr SettingWireGuard)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
CString
publicKey' <- Text -> IO CString
textToCString Text
publicKey
Ptr Word32
outIdx <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
Ptr WireGuardPeer
result <- Ptr SettingWireGuard
-> CString -> Ptr Word32 -> IO (Ptr WireGuardPeer)
nm_setting_wireguard_get_peer_by_public_key Ptr SettingWireGuard
self' CString
publicKey' Ptr Word32
outIdx
Maybe WireGuardPeer
maybeResult <- Ptr WireGuardPeer
-> (Ptr WireGuardPeer -> IO WireGuardPeer)
-> IO (Maybe WireGuardPeer)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr WireGuardPeer
result ((Ptr WireGuardPeer -> IO WireGuardPeer)
-> IO (Maybe WireGuardPeer))
-> (Ptr WireGuardPeer -> IO WireGuardPeer)
-> IO (Maybe WireGuardPeer)
forall a b. (a -> b) -> a -> b
$ \Ptr WireGuardPeer
result' -> do
WireGuardPeer
result'' <- ((ManagedPtr WireGuardPeer -> WireGuardPeer)
-> Ptr WireGuardPeer -> IO WireGuardPeer
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr WireGuardPeer -> WireGuardPeer
NM.WireGuardPeer.WireGuardPeer) Ptr WireGuardPeer
result'
WireGuardPeer -> IO WireGuardPeer
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return WireGuardPeer
result''
Word32
outIdx' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
outIdx
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
publicKey'
Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
outIdx
(Maybe WireGuardPeer, Word32) -> IO (Maybe WireGuardPeer, Word32)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe WireGuardPeer
maybeResult, Word32
outIdx')
#if defined(ENABLE_OVERLOADING)
data SettingWireGuardGetPeerByPublicKeyMethodInfo
instance (signature ~ (T.Text -> m ((Maybe NM.WireGuardPeer.WireGuardPeer, Word32))), MonadIO m, IsSettingWireGuard a) => O.OverloadedMethod SettingWireGuardGetPeerByPublicKeyMethodInfo a signature where
overloadedMethod = settingWireGuardGetPeerByPublicKey
instance O.OverloadedMethodInfo SettingWireGuardGetPeerByPublicKeyMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingWireGuard.settingWireGuardGetPeerByPublicKey",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingWireGuard.html#v:settingWireGuardGetPeerByPublicKey"
})
#endif
foreign import ccall "nm_setting_wireguard_get_peer_routes" nm_setting_wireguard_get_peer_routes ::
Ptr SettingWireGuard ->
IO CInt
settingWireGuardGetPeerRoutes ::
(B.CallStack.HasCallStack, MonadIO m, IsSettingWireGuard a) =>
a
-> m Bool
settingWireGuardGetPeerRoutes :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingWireGuard a) =>
a -> m Bool
settingWireGuardGetPeerRoutes a
self = 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 SettingWireGuard
self' <- a -> IO (Ptr SettingWireGuard)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
CInt
result <- Ptr SettingWireGuard -> IO CInt
nm_setting_wireguard_get_peer_routes Ptr SettingWireGuard
self'
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
self
Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data SettingWireGuardGetPeerRoutesMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsSettingWireGuard a) => O.OverloadedMethod SettingWireGuardGetPeerRoutesMethodInfo a signature where
overloadedMethod = settingWireGuardGetPeerRoutes
instance O.OverloadedMethodInfo SettingWireGuardGetPeerRoutesMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingWireGuard.settingWireGuardGetPeerRoutes",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingWireGuard.html#v:settingWireGuardGetPeerRoutes"
})
#endif
foreign import ccall "nm_setting_wireguard_get_peers_len" nm_setting_wireguard_get_peers_len ::
Ptr SettingWireGuard ->
IO Word32
settingWireGuardGetPeersLen ::
(B.CallStack.HasCallStack, MonadIO m, IsSettingWireGuard a) =>
a
-> m Word32
settingWireGuardGetPeersLen :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingWireGuard a) =>
a -> m Word32
settingWireGuardGetPeersLen a
self = 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 SettingWireGuard
self' <- a -> IO (Ptr SettingWireGuard)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
Word32
result <- Ptr SettingWireGuard -> IO Word32
nm_setting_wireguard_get_peers_len Ptr SettingWireGuard
self'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result
#if defined(ENABLE_OVERLOADING)
data SettingWireGuardGetPeersLenMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsSettingWireGuard a) => O.OverloadedMethod SettingWireGuardGetPeersLenMethodInfo a signature where
overloadedMethod = settingWireGuardGetPeersLen
instance O.OverloadedMethodInfo SettingWireGuardGetPeersLenMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingWireGuard.settingWireGuardGetPeersLen",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingWireGuard.html#v:settingWireGuardGetPeersLen"
})
#endif
foreign import ccall "nm_setting_wireguard_get_private_key" nm_setting_wireguard_get_private_key ::
Ptr SettingWireGuard ->
IO CString
settingWireGuardGetPrivateKey ::
(B.CallStack.HasCallStack, MonadIO m, IsSettingWireGuard a) =>
a
-> m T.Text
settingWireGuardGetPrivateKey :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingWireGuard a) =>
a -> m Text
settingWireGuardGetPrivateKey a
self = 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 SettingWireGuard
self' <- a -> IO (Ptr SettingWireGuard)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
CString
result <- Ptr SettingWireGuard -> IO CString
nm_setting_wireguard_get_private_key Ptr SettingWireGuard
self'
Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"settingWireGuardGetPrivateKey" CString
result
Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'
#if defined(ENABLE_OVERLOADING)
data SettingWireGuardGetPrivateKeyMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsSettingWireGuard a) => O.OverloadedMethod SettingWireGuardGetPrivateKeyMethodInfo a signature where
overloadedMethod = settingWireGuardGetPrivateKey
instance O.OverloadedMethodInfo SettingWireGuardGetPrivateKeyMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingWireGuard.settingWireGuardGetPrivateKey",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingWireGuard.html#v:settingWireGuardGetPrivateKey"
})
#endif
foreign import ccall "nm_setting_wireguard_get_private_key_flags" nm_setting_wireguard_get_private_key_flags ::
Ptr SettingWireGuard ->
IO CUInt
settingWireGuardGetPrivateKeyFlags ::
(B.CallStack.HasCallStack, MonadIO m, IsSettingWireGuard a) =>
a
-> m [NM.Flags.SettingSecretFlags]
settingWireGuardGetPrivateKeyFlags :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingWireGuard a) =>
a -> m [SettingSecretFlags]
settingWireGuardGetPrivateKeyFlags a
self = 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 SettingWireGuard
self' <- a -> IO (Ptr SettingWireGuard)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
CUInt
result <- Ptr SettingWireGuard -> IO CUInt
nm_setting_wireguard_get_private_key_flags Ptr SettingWireGuard
self'
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
self
[SettingSecretFlags] -> IO [SettingSecretFlags]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [SettingSecretFlags]
result'
#if defined(ENABLE_OVERLOADING)
data SettingWireGuardGetPrivateKeyFlagsMethodInfo
instance (signature ~ (m [NM.Flags.SettingSecretFlags]), MonadIO m, IsSettingWireGuard a) => O.OverloadedMethod SettingWireGuardGetPrivateKeyFlagsMethodInfo a signature where
overloadedMethod = settingWireGuardGetPrivateKeyFlags
instance O.OverloadedMethodInfo SettingWireGuardGetPrivateKeyFlagsMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingWireGuard.settingWireGuardGetPrivateKeyFlags",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingWireGuard.html#v:settingWireGuardGetPrivateKeyFlags"
})
#endif
foreign import ccall "nm_setting_wireguard_remove_peer" nm_setting_wireguard_remove_peer ::
Ptr SettingWireGuard ->
Word32 ->
IO CInt
settingWireGuardRemovePeer ::
(B.CallStack.HasCallStack, MonadIO m, IsSettingWireGuard a) =>
a
-> Word32
-> m Bool
settingWireGuardRemovePeer :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingWireGuard a) =>
a -> Word32 -> m Bool
settingWireGuardRemovePeer a
self Word32
idx = 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 SettingWireGuard
self' <- a -> IO (Ptr SettingWireGuard)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
CInt
result <- Ptr SettingWireGuard -> Word32 -> IO CInt
nm_setting_wireguard_remove_peer Ptr SettingWireGuard
self' Word32
idx
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
self
Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data SettingWireGuardRemovePeerMethodInfo
instance (signature ~ (Word32 -> m Bool), MonadIO m, IsSettingWireGuard a) => O.OverloadedMethod SettingWireGuardRemovePeerMethodInfo a signature where
overloadedMethod = settingWireGuardRemovePeer
instance O.OverloadedMethodInfo SettingWireGuardRemovePeerMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingWireGuard.settingWireGuardRemovePeer",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingWireGuard.html#v:settingWireGuardRemovePeer"
})
#endif
foreign import ccall "nm_setting_wireguard_set_peer" nm_setting_wireguard_set_peer ::
Ptr SettingWireGuard ->
Ptr NM.WireGuardPeer.WireGuardPeer ->
Word32 ->
IO ()
settingWireGuardSetPeer ::
(B.CallStack.HasCallStack, MonadIO m, IsSettingWireGuard a) =>
a
-> NM.WireGuardPeer.WireGuardPeer
-> Word32
-> m ()
settingWireGuardSetPeer :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSettingWireGuard a) =>
a -> WireGuardPeer -> Word32 -> m ()
settingWireGuardSetPeer a
self WireGuardPeer
peer Word32
idx = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr SettingWireGuard
self' <- a -> IO (Ptr SettingWireGuard)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
Ptr WireGuardPeer
peer' <- WireGuardPeer -> IO (Ptr WireGuardPeer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WireGuardPeer
peer
Ptr SettingWireGuard -> Ptr WireGuardPeer -> Word32 -> IO ()
nm_setting_wireguard_set_peer Ptr SettingWireGuard
self' Ptr WireGuardPeer
peer' Word32
idx
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
WireGuardPeer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WireGuardPeer
peer
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data SettingWireGuardSetPeerMethodInfo
instance (signature ~ (NM.WireGuardPeer.WireGuardPeer -> Word32 -> m ()), MonadIO m, IsSettingWireGuard a) => O.OverloadedMethod SettingWireGuardSetPeerMethodInfo a signature where
overloadedMethod = settingWireGuardSetPeer
instance O.OverloadedMethodInfo SettingWireGuardSetPeerMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.NM.Objects.SettingWireGuard.settingWireGuardSetPeer",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-SettingWireGuard.html#v:settingWireGuardSetPeer"
})
#endif