{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif

module GI.NM.Objects.VpnPluginInfo
    ( 

-- * Exported types
    VpnPluginInfo(..)                       ,
    IsVpnPluginInfo                         ,
    toVpnPluginInfo                         ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [init]("GI.Gio.Interfaces.Initable#g:method:init"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [loadEditorPlugin]("GI.NM.Objects.VpnPluginInfo#g:method:loadEditorPlugin"), [lookupProperty]("GI.NM.Objects.VpnPluginInfo#g:method:lookupProperty"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [supportsHints]("GI.NM.Objects.VpnPluginInfo#g:method:supportsHints"), [supportsMultiple]("GI.NM.Objects.VpnPluginInfo#g:method:supportsMultiple"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getAliases]("GI.NM.Objects.VpnPluginInfo#g:method:getAliases"), [getAuthDialog]("GI.NM.Objects.VpnPluginInfo#g:method:getAuthDialog"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getEditorPlugin]("GI.NM.Objects.VpnPluginInfo#g:method:getEditorPlugin"), [getFilename]("GI.NM.Objects.VpnPluginInfo#g:method:getFilename"), [getName]("GI.NM.Objects.VpnPluginInfo#g:method:getName"), [getPlugin]("GI.NM.Objects.VpnPluginInfo#g:method:getPlugin"), [getProgram]("GI.NM.Objects.VpnPluginInfo#g:method:getProgram"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getService]("GI.NM.Objects.VpnPluginInfo#g:method:getService").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setEditorPlugin]("GI.NM.Objects.VpnPluginInfo#g:method:setEditorPlugin"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveVpnPluginInfoMethod              ,
#endif

-- ** getAliases #method:getAliases#

#if defined(ENABLE_OVERLOADING)
    VpnPluginInfoGetAliasesMethodInfo       ,
#endif
    vpnPluginInfoGetAliases                 ,


-- ** getAuthDialog #method:getAuthDialog#

#if defined(ENABLE_OVERLOADING)
    VpnPluginInfoGetAuthDialogMethodInfo    ,
#endif
    vpnPluginInfoGetAuthDialog              ,


-- ** getEditorPlugin #method:getEditorPlugin#

#if defined(ENABLE_OVERLOADING)
    VpnPluginInfoGetEditorPluginMethodInfo  ,
#endif
    vpnPluginInfoGetEditorPlugin            ,


-- ** getFilename #method:getFilename#

#if defined(ENABLE_OVERLOADING)
    VpnPluginInfoGetFilenameMethodInfo      ,
#endif
    vpnPluginInfoGetFilename                ,


-- ** getName #method:getName#

#if defined(ENABLE_OVERLOADING)
    VpnPluginInfoGetNameMethodInfo          ,
#endif
    vpnPluginInfoGetName                    ,


-- ** getPlugin #method:getPlugin#

#if defined(ENABLE_OVERLOADING)
    VpnPluginInfoGetPluginMethodInfo        ,
#endif
    vpnPluginInfoGetPlugin                  ,


-- ** getProgram #method:getProgram#

#if defined(ENABLE_OVERLOADING)
    VpnPluginInfoGetProgramMethodInfo       ,
#endif
    vpnPluginInfoGetProgram                 ,


-- ** getService #method:getService#

#if defined(ENABLE_OVERLOADING)
    VpnPluginInfoGetServiceMethodInfo       ,
#endif
    vpnPluginInfoGetService                 ,


-- ** listAdd #method:listAdd#

    vpnPluginInfoListAdd                    ,


-- ** listFindByFilename #method:listFindByFilename#

    vpnPluginInfoListFindByFilename         ,


-- ** listFindByName #method:listFindByName#

    vpnPluginInfoListFindByName             ,


-- ** listFindByService #method:listFindByService#

    vpnPluginInfoListFindByService          ,


-- ** listFindServiceType #method:listFindServiceType#

    vpnPluginInfoListFindServiceType        ,


-- ** listGetServiceTypes #method:listGetServiceTypes#

    vpnPluginInfoListGetServiceTypes        ,


-- ** listLoad #method:listLoad#

    vpnPluginInfoListLoad                   ,


-- ** listRemove #method:listRemove#

    vpnPluginInfoListRemove                 ,


-- ** loadEditorPlugin #method:loadEditorPlugin#

#if defined(ENABLE_OVERLOADING)
    VpnPluginInfoLoadEditorPluginMethodInfo ,
#endif
    vpnPluginInfoLoadEditorPlugin           ,


-- ** lookupProperty #method:lookupProperty#

#if defined(ENABLE_OVERLOADING)
    VpnPluginInfoLookupPropertyMethodInfo   ,
#endif
    vpnPluginInfoLookupProperty             ,


-- ** newFromFile #method:newFromFile#

    vpnPluginInfoNewFromFile                ,


-- ** newSearchFile #method:newSearchFile#

    vpnPluginInfoNewSearchFile              ,


-- ** newWithData #method:newWithData#

    vpnPluginInfoNewWithData                ,


-- ** setEditorPlugin #method:setEditorPlugin#

#if defined(ENABLE_OVERLOADING)
    VpnPluginInfoSetEditorPluginMethodInfo  ,
#endif
    vpnPluginInfoSetEditorPlugin            ,


-- ** supportsHints #method:supportsHints#

#if defined(ENABLE_OVERLOADING)
    VpnPluginInfoSupportsHintsMethodInfo    ,
#endif
    vpnPluginInfoSupportsHints              ,


-- ** supportsMultiple #method:supportsMultiple#

#if defined(ENABLE_OVERLOADING)
    VpnPluginInfoSupportsMultipleMethodInfo ,
#endif
    vpnPluginInfoSupportsMultiple           ,


-- ** validateFilename #method:validateFilename#

    vpnPluginInfoValidateFilename           ,




 -- * Properties


-- ** filename #attr:filename#
-- | The filename from which the info was loaded.
-- Can be 'P.Nothing' if the instance was not loaded from
-- a file (i.e. the keyfile instance was passed to the
-- constructor).
-- 
-- /Since: 1.2/

#if defined(ENABLE_OVERLOADING)
    VpnPluginInfoFilenamePropertyInfo       ,
#endif
    constructVpnPluginInfoFilename          ,
    getVpnPluginInfoFilename                ,
#if defined(ENABLE_OVERLOADING)
    vpnPluginInfoFilename                   ,
#endif


-- ** keyfile #attr:keyfile#
-- | Initialize the instance with a different keyfile instance.
-- When passing a keyfile instance, the constructor will not
-- try to read from filename.
-- 
-- /Since: 1.2/

#if defined(ENABLE_OVERLOADING)
    VpnPluginInfoKeyfilePropertyInfo        ,
#endif
    constructVpnPluginInfoKeyfile           ,
#if defined(ENABLE_OVERLOADING)
    vpnPluginInfoKeyfile                    ,
#endif


-- ** name #attr:name#
-- | The name of the VPN plugin.
-- 
-- /Since: 1.2/

#if defined(ENABLE_OVERLOADING)
    VpnPluginInfoNamePropertyInfo           ,
#endif
    getVpnPluginInfoName                    ,
#if defined(ENABLE_OVERLOADING)
    vpnPluginInfoName                       ,
#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

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.GLib.Structs.Bytes as GLib.Bytes
import qualified GI.GLib.Structs.KeyFile as GLib.KeyFile
import qualified GI.GLib.Structs.VariantType as GLib.VariantType
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Interfaces.Initable as Gio.Initable
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.Interfaces.VpnEditor as NM.VpnEditor
import {-# SOURCE #-} qualified GI.NM.Interfaces.VpnEditorPlugin as NM.VpnEditorPlugin
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

#else
import qualified GI.GLib.Structs.KeyFile as GLib.KeyFile
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Interfaces.Initable as Gio.Initable
import {-# SOURCE #-} qualified GI.NM.Interfaces.VpnEditorPlugin as NM.VpnEditorPlugin

#endif

-- | Memory-managed wrapper type.
newtype VpnPluginInfo = VpnPluginInfo (SP.ManagedPtr VpnPluginInfo)
    deriving (VpnPluginInfo -> VpnPluginInfo -> Bool
(VpnPluginInfo -> VpnPluginInfo -> Bool)
-> (VpnPluginInfo -> VpnPluginInfo -> Bool) -> Eq VpnPluginInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VpnPluginInfo -> VpnPluginInfo -> Bool
== :: VpnPluginInfo -> VpnPluginInfo -> Bool
$c/= :: VpnPluginInfo -> VpnPluginInfo -> Bool
/= :: VpnPluginInfo -> VpnPluginInfo -> Bool
Eq)

instance SP.ManagedPtrNewtype VpnPluginInfo where
    toManagedPtr :: VpnPluginInfo -> ManagedPtr VpnPluginInfo
toManagedPtr (VpnPluginInfo ManagedPtr VpnPluginInfo
p) = ManagedPtr VpnPluginInfo
p

foreign import ccall "nm_vpn_plugin_info_get_type"
    c_nm_vpn_plugin_info_get_type :: IO B.Types.GType

instance B.Types.TypedObject VpnPluginInfo where
    glibType :: IO GType
glibType = IO GType
c_nm_vpn_plugin_info_get_type

instance B.Types.GObject VpnPluginInfo

-- | Type class for types which can be safely cast to t'VpnPluginInfo', for instance with `toVpnPluginInfo`.
class (SP.GObject o, O.IsDescendantOf VpnPluginInfo o) => IsVpnPluginInfo o
instance (SP.GObject o, O.IsDescendantOf VpnPluginInfo o) => IsVpnPluginInfo o

instance O.HasParentTypes VpnPluginInfo
type instance O.ParentTypes VpnPluginInfo = '[GObject.Object.Object, Gio.Initable.Initable]

-- | Cast to t'VpnPluginInfo', for types for which this is known to be safe. For general casts, use 'Data.GI.Base.ManagedPtr.castTo'.
toVpnPluginInfo :: (MIO.MonadIO m, IsVpnPluginInfo o) => o -> m VpnPluginInfo
toVpnPluginInfo :: forall (m :: * -> *) o.
(MonadIO m, IsVpnPluginInfo o) =>
o -> m VpnPluginInfo
toVpnPluginInfo = IO VpnPluginInfo -> m VpnPluginInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO VpnPluginInfo -> m VpnPluginInfo)
-> (o -> IO VpnPluginInfo) -> o -> m VpnPluginInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr VpnPluginInfo -> VpnPluginInfo)
-> o -> IO VpnPluginInfo
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr VpnPluginInfo -> VpnPluginInfo
VpnPluginInfo

-- | Convert t'VpnPluginInfo' to and from t'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe VpnPluginInfo) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_nm_vpn_plugin_info_get_type
    gvalueSet_ :: Ptr GValue -> Maybe VpnPluginInfo -> IO ()
gvalueSet_ Ptr GValue
gv Maybe VpnPluginInfo
P.Nothing = Ptr GValue -> Ptr VpnPluginInfo -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr VpnPluginInfo
forall a. Ptr a
FP.nullPtr :: FP.Ptr VpnPluginInfo)
    gvalueSet_ Ptr GValue
gv (P.Just VpnPluginInfo
obj) = VpnPluginInfo -> (Ptr VpnPluginInfo -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr VpnPluginInfo
obj (Ptr GValue -> Ptr VpnPluginInfo -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe VpnPluginInfo)
gvalueGet_ Ptr GValue
gv = do
        Ptr VpnPluginInfo
ptr <- Ptr GValue -> IO (Ptr VpnPluginInfo)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr VpnPluginInfo)
        if Ptr VpnPluginInfo
ptr Ptr VpnPluginInfo -> Ptr VpnPluginInfo -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr VpnPluginInfo
forall a. Ptr a
FP.nullPtr
        then VpnPluginInfo -> Maybe VpnPluginInfo
forall a. a -> Maybe a
P.Just (VpnPluginInfo -> Maybe VpnPluginInfo)
-> IO VpnPluginInfo -> IO (Maybe VpnPluginInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr VpnPluginInfo -> VpnPluginInfo)
-> Ptr VpnPluginInfo -> IO VpnPluginInfo
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr VpnPluginInfo -> VpnPluginInfo
VpnPluginInfo Ptr VpnPluginInfo
ptr
        else Maybe VpnPluginInfo -> IO (Maybe VpnPluginInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe VpnPluginInfo
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveVpnPluginInfoMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveVpnPluginInfoMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveVpnPluginInfoMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveVpnPluginInfoMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveVpnPluginInfoMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveVpnPluginInfoMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveVpnPluginInfoMethod "init" o = Gio.Initable.InitableInitMethodInfo
    ResolveVpnPluginInfoMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveVpnPluginInfoMethod "loadEditorPlugin" o = VpnPluginInfoLoadEditorPluginMethodInfo
    ResolveVpnPluginInfoMethod "lookupProperty" o = VpnPluginInfoLookupPropertyMethodInfo
    ResolveVpnPluginInfoMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveVpnPluginInfoMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveVpnPluginInfoMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveVpnPluginInfoMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveVpnPluginInfoMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveVpnPluginInfoMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveVpnPluginInfoMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveVpnPluginInfoMethod "supportsHints" o = VpnPluginInfoSupportsHintsMethodInfo
    ResolveVpnPluginInfoMethod "supportsMultiple" o = VpnPluginInfoSupportsMultipleMethodInfo
    ResolveVpnPluginInfoMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveVpnPluginInfoMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveVpnPluginInfoMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveVpnPluginInfoMethod "getAliases" o = VpnPluginInfoGetAliasesMethodInfo
    ResolveVpnPluginInfoMethod "getAuthDialog" o = VpnPluginInfoGetAuthDialogMethodInfo
    ResolveVpnPluginInfoMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveVpnPluginInfoMethod "getEditorPlugin" o = VpnPluginInfoGetEditorPluginMethodInfo
    ResolveVpnPluginInfoMethod "getFilename" o = VpnPluginInfoGetFilenameMethodInfo
    ResolveVpnPluginInfoMethod "getName" o = VpnPluginInfoGetNameMethodInfo
    ResolveVpnPluginInfoMethod "getPlugin" o = VpnPluginInfoGetPluginMethodInfo
    ResolveVpnPluginInfoMethod "getProgram" o = VpnPluginInfoGetProgramMethodInfo
    ResolveVpnPluginInfoMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveVpnPluginInfoMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveVpnPluginInfoMethod "getService" o = VpnPluginInfoGetServiceMethodInfo
    ResolveVpnPluginInfoMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveVpnPluginInfoMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveVpnPluginInfoMethod "setEditorPlugin" o = VpnPluginInfoSetEditorPluginMethodInfo
    ResolveVpnPluginInfoMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveVpnPluginInfoMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveVpnPluginInfoMethod t VpnPluginInfo, O.OverloadedMethod info VpnPluginInfo p) => OL.IsLabel t (VpnPluginInfo -> 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 ~ ResolveVpnPluginInfoMethod t VpnPluginInfo, O.OverloadedMethod info VpnPluginInfo p, R.HasField t VpnPluginInfo p) => R.HasField t VpnPluginInfo p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolveVpnPluginInfoMethod t VpnPluginInfo, O.OverloadedMethodInfo info VpnPluginInfo) => OL.IsLabel t (O.MethodProxy info VpnPluginInfo) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif

-- VVV Prop "filename"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@filename@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' vpnPluginInfo #filename
-- @
getVpnPluginInfoFilename :: (MonadIO m, IsVpnPluginInfo o) => o -> m T.Text
getVpnPluginInfoFilename :: forall (m :: * -> *) o.
(MonadIO m, IsVpnPluginInfo o) =>
o -> m Text
getVpnPluginInfoFilename 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
"getVpnPluginInfoFilename" (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
"filename"

-- | Construct a t'GValueConstruct' with valid value for the “@filename@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructVpnPluginInfoFilename :: (IsVpnPluginInfo o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructVpnPluginInfoFilename :: forall o (m :: * -> *).
(IsVpnPluginInfo o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructVpnPluginInfoFilename 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
"filename" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data VpnPluginInfoFilenamePropertyInfo
instance AttrInfo VpnPluginInfoFilenamePropertyInfo where
    type AttrAllowedOps VpnPluginInfoFilenamePropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint VpnPluginInfoFilenamePropertyInfo = IsVpnPluginInfo
    type AttrSetTypeConstraint VpnPluginInfoFilenamePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint VpnPluginInfoFilenamePropertyInfo = (~) T.Text
    type AttrTransferType VpnPluginInfoFilenamePropertyInfo = T.Text
    type AttrGetType VpnPluginInfoFilenamePropertyInfo = T.Text
    type AttrLabel VpnPluginInfoFilenamePropertyInfo = "filename"
    type AttrOrigin VpnPluginInfoFilenamePropertyInfo = VpnPluginInfo
    attrGet = getVpnPluginInfoFilename
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructVpnPluginInfoFilename
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.VpnPluginInfo.filename"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-VpnPluginInfo.html#g:attr:filename"
        })
#endif

-- VVV Prop "keyfile"
   -- Type: TInterface (Name {namespace = "GLib", name = "KeyFile"})
   -- Flags: [PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Construct a t'GValueConstruct' with valid value for the “@keyfile@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructVpnPluginInfoKeyfile :: (IsVpnPluginInfo o, MIO.MonadIO m) => GLib.KeyFile.KeyFile -> m (GValueConstruct o)
constructVpnPluginInfoKeyfile :: forall o (m :: * -> *).
(IsVpnPluginInfo o, MonadIO m) =>
KeyFile -> m (GValueConstruct o)
constructVpnPluginInfoKeyfile KeyFile
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 KeyFile -> IO (GValueConstruct o)
forall a o. GBoxed a => String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBoxed String
"keyfile" (KeyFile -> Maybe KeyFile
forall a. a -> Maybe a
P.Just KeyFile
val)

#if defined(ENABLE_OVERLOADING)
data VpnPluginInfoKeyfilePropertyInfo
instance AttrInfo VpnPluginInfoKeyfilePropertyInfo where
    type AttrAllowedOps VpnPluginInfoKeyfilePropertyInfo = '[ 'AttrConstruct, 'AttrClear]
    type AttrBaseTypeConstraint VpnPluginInfoKeyfilePropertyInfo = IsVpnPluginInfo
    type AttrSetTypeConstraint VpnPluginInfoKeyfilePropertyInfo = (~) GLib.KeyFile.KeyFile
    type AttrTransferTypeConstraint VpnPluginInfoKeyfilePropertyInfo = (~) GLib.KeyFile.KeyFile
    type AttrTransferType VpnPluginInfoKeyfilePropertyInfo = GLib.KeyFile.KeyFile
    type AttrGetType VpnPluginInfoKeyfilePropertyInfo = ()
    type AttrLabel VpnPluginInfoKeyfilePropertyInfo = "keyfile"
    type AttrOrigin VpnPluginInfoKeyfilePropertyInfo = VpnPluginInfo
    attrGet = undefined
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructVpnPluginInfoKeyfile
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.VpnPluginInfo.keyfile"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-VpnPluginInfo.html#g:attr:keyfile"
        })
#endif

-- VVV Prop "name"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@name@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' vpnPluginInfo #name
-- @
getVpnPluginInfoName :: (MonadIO m, IsVpnPluginInfo o) => o -> m T.Text
getVpnPluginInfoName :: forall (m :: * -> *) o.
(MonadIO m, IsVpnPluginInfo o) =>
o -> m Text
getVpnPluginInfoName 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
"getVpnPluginInfoName" (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
"name"

#if defined(ENABLE_OVERLOADING)
data VpnPluginInfoNamePropertyInfo
instance AttrInfo VpnPluginInfoNamePropertyInfo where
    type AttrAllowedOps VpnPluginInfoNamePropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint VpnPluginInfoNamePropertyInfo = IsVpnPluginInfo
    type AttrSetTypeConstraint VpnPluginInfoNamePropertyInfo = (~) ()
    type AttrTransferTypeConstraint VpnPluginInfoNamePropertyInfo = (~) ()
    type AttrTransferType VpnPluginInfoNamePropertyInfo = ()
    type AttrGetType VpnPluginInfoNamePropertyInfo = T.Text
    type AttrLabel VpnPluginInfoNamePropertyInfo = "name"
    type AttrOrigin VpnPluginInfoNamePropertyInfo = VpnPluginInfo
    attrGet = getVpnPluginInfoName
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.VpnPluginInfo.name"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-VpnPluginInfo.html#g:attr:name"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList VpnPluginInfo
type instance O.AttributeList VpnPluginInfo = VpnPluginInfoAttributeList
type VpnPluginInfoAttributeList = ('[ '("filename", VpnPluginInfoFilenamePropertyInfo), '("keyfile", VpnPluginInfoKeyfilePropertyInfo), '("name", VpnPluginInfoNamePropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
vpnPluginInfoFilename :: AttrLabelProxy "filename"
vpnPluginInfoFilename = AttrLabelProxy

vpnPluginInfoKeyfile :: AttrLabelProxy "keyfile"
vpnPluginInfoKeyfile = AttrLabelProxy

vpnPluginInfoName :: AttrLabelProxy "name"
vpnPluginInfoName = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList VpnPluginInfo = VpnPluginInfoSignalList
type VpnPluginInfoSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])

#endif

-- method VpnPluginInfo::new_from_file
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "filename"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "filename to read." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "NM" , name = "VpnPluginInfo" })
-- throws : True
-- Skip return : False

foreign import ccall "nm_vpn_plugin_info_new_from_file" nm_vpn_plugin_info_new_from_file :: 
    CString ->                              -- filename : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr VpnPluginInfo)

-- | Read the plugin info from file /@filename@/. Does not do
-- any further verification on the file. You might want to check
-- file permissions and ownership of the file.
-- 
-- /Since: 1.2/
vpnPluginInfoNewFromFile ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@filename@/: filename to read.
    -> m VpnPluginInfo
    -- ^ __Returns:__ 'P.Nothing' if there is any error or a newly created
    -- t'GI.NM.Objects.VpnPluginInfo.VpnPluginInfo' instance. /(Can throw 'Data.GI.Base.GError.GError')/
vpnPluginInfoNewFromFile :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> m VpnPluginInfo
vpnPluginInfoNewFromFile Text
filename = IO VpnPluginInfo -> m VpnPluginInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VpnPluginInfo -> m VpnPluginInfo)
-> IO VpnPluginInfo -> m VpnPluginInfo
forall a b. (a -> b) -> a -> b
$ do
    CString
filename' <- Text -> IO CString
textToCString Text
filename
    IO VpnPluginInfo -> IO () -> IO VpnPluginInfo
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr VpnPluginInfo
result <- (Ptr (Ptr GError) -> IO (Ptr VpnPluginInfo))
-> IO (Ptr VpnPluginInfo)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr VpnPluginInfo))
 -> IO (Ptr VpnPluginInfo))
-> (Ptr (Ptr GError) -> IO (Ptr VpnPluginInfo))
-> IO (Ptr VpnPluginInfo)
forall a b. (a -> b) -> a -> b
$ CString -> Ptr (Ptr GError) -> IO (Ptr VpnPluginInfo)
nm_vpn_plugin_info_new_from_file CString
filename'
        Text -> Ptr VpnPluginInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"vpnPluginInfoNewFromFile" Ptr VpnPluginInfo
result
        VpnPluginInfo
result' <- ((ManagedPtr VpnPluginInfo -> VpnPluginInfo)
-> Ptr VpnPluginInfo -> IO VpnPluginInfo
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr VpnPluginInfo -> VpnPluginInfo
VpnPluginInfo) Ptr VpnPluginInfo
result
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
filename'
        VpnPluginInfo -> IO VpnPluginInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return VpnPluginInfo
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
filename'
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method VpnPluginInfo::new_search_file
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the name to search for. Either @name or @service\n  must be present."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "service"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the service to search for. Either @name  or\n  @service must be present."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "NM" , name = "VpnPluginInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "nm_vpn_plugin_info_new_search_file" nm_vpn_plugin_info_new_search_file :: 
    CString ->                              -- name : TBasicType TUTF8
    CString ->                              -- service : TBasicType TUTF8
    IO (Ptr VpnPluginInfo)

-- | This has the same effect as doing a full 'GI.NM.Objects.VpnPluginInfo.vpnPluginInfoListLoad'
-- followed by a search for the first matching VPN plugin info that has the
-- given /@name@/ and\/or /@service@/.
-- 
-- /Since: 1.4/
vpnPluginInfoNewSearchFile ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Maybe (T.Text)
    -- ^ /@name@/: the name to search for. Either /@name@/ or /@service@/
    --   must be present.
    -> Maybe (T.Text)
    -- ^ /@service@/: the service to search for. Either /@name@/  or
    --   /@service@/ must be present.
    -> m (Maybe VpnPluginInfo)
    -- ^ __Returns:__ a newly created instance of plugin info
    --   or 'P.Nothing' if no matching value was found.
vpnPluginInfoNewSearchFile :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Maybe Text -> Maybe Text -> m (Maybe VpnPluginInfo)
vpnPluginInfoNewSearchFile Maybe Text
name Maybe Text
service = IO (Maybe VpnPluginInfo) -> m (Maybe VpnPluginInfo)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe VpnPluginInfo) -> m (Maybe VpnPluginInfo))
-> IO (Maybe VpnPluginInfo) -> m (Maybe VpnPluginInfo)
forall a b. (a -> b) -> a -> b
$ do
    CString
maybeName <- case Maybe Text
name of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
FP.nullPtr
        Just Text
jName -> do
            CString
jName' <- Text -> IO CString
textToCString Text
jName
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jName'
    CString
maybeService <- case Maybe Text
service of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
FP.nullPtr
        Just Text
jService -> do
            CString
jService' <- Text -> IO CString
textToCString Text
jService
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jService'
    Ptr VpnPluginInfo
result <- CString -> CString -> IO (Ptr VpnPluginInfo)
nm_vpn_plugin_info_new_search_file CString
maybeName CString
maybeService
    Maybe VpnPluginInfo
maybeResult <- Ptr VpnPluginInfo
-> (Ptr VpnPluginInfo -> IO VpnPluginInfo)
-> IO (Maybe VpnPluginInfo)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr VpnPluginInfo
result ((Ptr VpnPluginInfo -> IO VpnPluginInfo)
 -> IO (Maybe VpnPluginInfo))
-> (Ptr VpnPluginInfo -> IO VpnPluginInfo)
-> IO (Maybe VpnPluginInfo)
forall a b. (a -> b) -> a -> b
$ \Ptr VpnPluginInfo
result' -> do
        VpnPluginInfo
result'' <- ((ManagedPtr VpnPluginInfo -> VpnPluginInfo)
-> Ptr VpnPluginInfo -> IO VpnPluginInfo
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr VpnPluginInfo -> VpnPluginInfo
VpnPluginInfo) Ptr VpnPluginInfo
result'
        VpnPluginInfo -> IO VpnPluginInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return VpnPluginInfo
result''
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeName
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeService
    Maybe VpnPluginInfo -> IO (Maybe VpnPluginInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe VpnPluginInfo
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

-- method VpnPluginInfo::new_with_data
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "filename"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "optional filename." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "keyfile"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "KeyFile" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "inject data for the plugin info instance."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "NM" , name = "VpnPluginInfo" })
-- throws : True
-- Skip return : False

foreign import ccall "nm_vpn_plugin_info_new_with_data" nm_vpn_plugin_info_new_with_data :: 
    CString ->                              -- filename : TBasicType TUTF8
    Ptr GLib.KeyFile.KeyFile ->             -- keyfile : TInterface (Name {namespace = "GLib", name = "KeyFile"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr VpnPluginInfo)

-- | This constructor does not read any data from file but
-- takes instead a /@keyfile@/ argument.
-- 
-- /Since: 1.2/
vpnPluginInfoNewWithData ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@filename@/: optional filename.
    -> GLib.KeyFile.KeyFile
    -- ^ /@keyfile@/: inject data for the plugin info instance.
    -> m VpnPluginInfo
    -- ^ __Returns:__ new plugin info instance. /(Can throw 'Data.GI.Base.GError.GError')/
vpnPluginInfoNewWithData :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> KeyFile -> m VpnPluginInfo
vpnPluginInfoNewWithData Text
filename KeyFile
keyfile = IO VpnPluginInfo -> m VpnPluginInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VpnPluginInfo -> m VpnPluginInfo)
-> IO VpnPluginInfo -> m VpnPluginInfo
forall a b. (a -> b) -> a -> b
$ do
    CString
filename' <- Text -> IO CString
textToCString Text
filename
    Ptr KeyFile
keyfile' <- KeyFile -> IO (Ptr KeyFile)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr KeyFile
keyfile
    IO VpnPluginInfo -> IO () -> IO VpnPluginInfo
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr VpnPluginInfo
result <- (Ptr (Ptr GError) -> IO (Ptr VpnPluginInfo))
-> IO (Ptr VpnPluginInfo)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr VpnPluginInfo))
 -> IO (Ptr VpnPluginInfo))
-> (Ptr (Ptr GError) -> IO (Ptr VpnPluginInfo))
-> IO (Ptr VpnPluginInfo)
forall a b. (a -> b) -> a -> b
$ CString
-> Ptr KeyFile -> Ptr (Ptr GError) -> IO (Ptr VpnPluginInfo)
nm_vpn_plugin_info_new_with_data CString
filename' Ptr KeyFile
keyfile'
        Text -> Ptr VpnPluginInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"vpnPluginInfoNewWithData" Ptr VpnPluginInfo
result
        VpnPluginInfo
result' <- ((ManagedPtr VpnPluginInfo -> VpnPluginInfo)
-> Ptr VpnPluginInfo -> IO VpnPluginInfo
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr VpnPluginInfo -> VpnPluginInfo
VpnPluginInfo) Ptr VpnPluginInfo
result
        KeyFile -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr KeyFile
keyfile
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
filename'
        VpnPluginInfo -> IO VpnPluginInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return VpnPluginInfo
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
filename'
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method VpnPluginInfo::get_aliases
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "VpnPluginInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "plugin info instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TCArray True (-1) (-1) (TBasicType TUTF8))
-- throws : False
-- Skip return : False

foreign import ccall "nm_vpn_plugin_info_get_aliases" nm_vpn_plugin_info_get_aliases :: 
    Ptr VpnPluginInfo ->                    -- self : TInterface (Name {namespace = "NM", name = "VpnPluginInfo"})
    IO (Ptr CString)

-- | /No description available in the introspection data./
-- 
-- /Since: 1.4/
vpnPluginInfoGetAliases ::
    (B.CallStack.HasCallStack, MonadIO m, IsVpnPluginInfo a) =>
    a
    -- ^ /@self@/: plugin info instance
    -> m [T.Text]
    -- ^ __Returns:__ 
    --   the aliases from the name-file.
vpnPluginInfoGetAliases :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVpnPluginInfo a) =>
a -> m [Text]
vpnPluginInfoGetAliases 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 VpnPluginInfo
self' <- a -> IO (Ptr VpnPluginInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CString
result <- Ptr VpnPluginInfo -> IO (Ptr CString)
nm_vpn_plugin_info_get_aliases Ptr VpnPluginInfo
self'
    Text -> Ptr CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"vpnPluginInfoGetAliases" Ptr CString
result
    [Text]
result' <- HasCallStack => Ptr CString -> IO [Text]
Ptr CString -> IO [Text]
unpackZeroTerminatedUTF8CArray Ptr 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 VpnPluginInfoGetAliasesMethodInfo
instance (signature ~ (m [T.Text]), MonadIO m, IsVpnPluginInfo a) => O.OverloadedMethod VpnPluginInfoGetAliasesMethodInfo a signature where
    overloadedMethod = vpnPluginInfoGetAliases

instance O.OverloadedMethodInfo VpnPluginInfoGetAliasesMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.VpnPluginInfo.vpnPluginInfoGetAliases",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-VpnPluginInfo.html#v:vpnPluginInfoGetAliases"
        })


#endif

-- method VpnPluginInfo::get_auth_dialog
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "VpnPluginInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "plugin info instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "nm_vpn_plugin_info_get_auth_dialog" nm_vpn_plugin_info_get_auth_dialog :: 
    Ptr VpnPluginInfo ->                    -- self : TInterface (Name {namespace = "NM", name = "VpnPluginInfo"})
    IO CString

-- | /No description available in the introspection data./
-- 
-- /Since: 1.4/
vpnPluginInfoGetAuthDialog ::
    (B.CallStack.HasCallStack, MonadIO m, IsVpnPluginInfo a) =>
    a
    -- ^ /@self@/: plugin info instance
    -> m T.Text
    -- ^ __Returns:__ the absolute path to the auth-dialog helper or 'P.Nothing'.
vpnPluginInfoGetAuthDialog :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVpnPluginInfo a) =>
a -> m Text
vpnPluginInfoGetAuthDialog 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 VpnPluginInfo
self' <- a -> IO (Ptr VpnPluginInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr VpnPluginInfo -> IO CString
nm_vpn_plugin_info_get_auth_dialog Ptr VpnPluginInfo
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"vpnPluginInfoGetAuthDialog" 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 VpnPluginInfoGetAuthDialogMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsVpnPluginInfo a) => O.OverloadedMethod VpnPluginInfoGetAuthDialogMethodInfo a signature where
    overloadedMethod = vpnPluginInfoGetAuthDialog

instance O.OverloadedMethodInfo VpnPluginInfoGetAuthDialogMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.VpnPluginInfo.vpnPluginInfoGetAuthDialog",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-VpnPluginInfo.html#v:vpnPluginInfoGetAuthDialog"
        })


#endif

-- method VpnPluginInfo::get_editor_plugin
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "VpnPluginInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "plugin info instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "NM" , name = "VpnEditorPlugin" })
-- throws : False
-- Skip return : False

foreign import ccall "nm_vpn_plugin_info_get_editor_plugin" nm_vpn_plugin_info_get_editor_plugin :: 
    Ptr VpnPluginInfo ->                    -- self : TInterface (Name {namespace = "NM", name = "VpnPluginInfo"})
    IO (Ptr NM.VpnEditorPlugin.VpnEditorPlugin)

-- | /No description available in the introspection data./
-- 
-- /Since: 1.2/
vpnPluginInfoGetEditorPlugin ::
    (B.CallStack.HasCallStack, MonadIO m, IsVpnPluginInfo a) =>
    a
    -- ^ /@self@/: plugin info instance
    -> m NM.VpnEditorPlugin.VpnEditorPlugin
    -- ^ __Returns:__ the cached t'GI.NM.Interfaces.VpnEditorPlugin.VpnEditorPlugin' instance.
vpnPluginInfoGetEditorPlugin :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVpnPluginInfo a) =>
a -> m VpnEditorPlugin
vpnPluginInfoGetEditorPlugin a
self = IO VpnEditorPlugin -> m VpnEditorPlugin
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VpnEditorPlugin -> m VpnEditorPlugin)
-> IO VpnEditorPlugin -> m VpnEditorPlugin
forall a b. (a -> b) -> a -> b
$ do
    Ptr VpnPluginInfo
self' <- a -> IO (Ptr VpnPluginInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr VpnEditorPlugin
result <- Ptr VpnPluginInfo -> IO (Ptr VpnEditorPlugin)
nm_vpn_plugin_info_get_editor_plugin Ptr VpnPluginInfo
self'
    Text -> Ptr VpnEditorPlugin -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"vpnPluginInfoGetEditorPlugin" Ptr VpnEditorPlugin
result
    VpnEditorPlugin
result' <- ((ManagedPtr VpnEditorPlugin -> VpnEditorPlugin)
-> Ptr VpnEditorPlugin -> IO VpnEditorPlugin
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr VpnEditorPlugin -> VpnEditorPlugin
NM.VpnEditorPlugin.VpnEditorPlugin) Ptr VpnEditorPlugin
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    VpnEditorPlugin -> IO VpnEditorPlugin
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return VpnEditorPlugin
result'

#if defined(ENABLE_OVERLOADING)
data VpnPluginInfoGetEditorPluginMethodInfo
instance (signature ~ (m NM.VpnEditorPlugin.VpnEditorPlugin), MonadIO m, IsVpnPluginInfo a) => O.OverloadedMethod VpnPluginInfoGetEditorPluginMethodInfo a signature where
    overloadedMethod = vpnPluginInfoGetEditorPlugin

instance O.OverloadedMethodInfo VpnPluginInfoGetEditorPluginMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.VpnPluginInfo.vpnPluginInfoGetEditorPlugin",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-VpnPluginInfo.html#v:vpnPluginInfoGetEditorPlugin"
        })


#endif

-- method VpnPluginInfo::get_filename
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "VpnPluginInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "plugin info instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "nm_vpn_plugin_info_get_filename" nm_vpn_plugin_info_get_filename :: 
    Ptr VpnPluginInfo ->                    -- self : TInterface (Name {namespace = "NM", name = "VpnPluginInfo"})
    IO CString

-- | /No description available in the introspection data./
-- 
-- /Since: 1.2/
vpnPluginInfoGetFilename ::
    (B.CallStack.HasCallStack, MonadIO m, IsVpnPluginInfo a) =>
    a
    -- ^ /@self@/: plugin info instance
    -> m T.Text
    -- ^ __Returns:__ the filename. Can be 'P.Nothing'.
vpnPluginInfoGetFilename :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVpnPluginInfo a) =>
a -> m Text
vpnPluginInfoGetFilename 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 VpnPluginInfo
self' <- a -> IO (Ptr VpnPluginInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr VpnPluginInfo -> IO CString
nm_vpn_plugin_info_get_filename Ptr VpnPluginInfo
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"vpnPluginInfoGetFilename" 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 VpnPluginInfoGetFilenameMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsVpnPluginInfo a) => O.OverloadedMethod VpnPluginInfoGetFilenameMethodInfo a signature where
    overloadedMethod = vpnPluginInfoGetFilename

instance O.OverloadedMethodInfo VpnPluginInfoGetFilenameMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.VpnPluginInfo.vpnPluginInfoGetFilename",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-VpnPluginInfo.html#v:vpnPluginInfoGetFilename"
        })


#endif

-- method VpnPluginInfo::get_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "VpnPluginInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "plugin info instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "nm_vpn_plugin_info_get_name" nm_vpn_plugin_info_get_name :: 
    Ptr VpnPluginInfo ->                    -- self : TInterface (Name {namespace = "NM", name = "VpnPluginInfo"})
    IO CString

-- | /No description available in the introspection data./
-- 
-- /Since: 1.2/
vpnPluginInfoGetName ::
    (B.CallStack.HasCallStack, MonadIO m, IsVpnPluginInfo a) =>
    a
    -- ^ /@self@/: plugin info instance
    -> m T.Text
    -- ^ __Returns:__ the name. Cannot be 'P.Nothing'.
vpnPluginInfoGetName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVpnPluginInfo a) =>
a -> m Text
vpnPluginInfoGetName 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 VpnPluginInfo
self' <- a -> IO (Ptr VpnPluginInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr VpnPluginInfo -> IO CString
nm_vpn_plugin_info_get_name Ptr VpnPluginInfo
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"vpnPluginInfoGetName" 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 VpnPluginInfoGetNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsVpnPluginInfo a) => O.OverloadedMethod VpnPluginInfoGetNameMethodInfo a signature where
    overloadedMethod = vpnPluginInfoGetName

instance O.OverloadedMethodInfo VpnPluginInfoGetNameMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.VpnPluginInfo.vpnPluginInfoGetName",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-VpnPluginInfo.html#v:vpnPluginInfoGetName"
        })


#endif

-- method VpnPluginInfo::get_plugin
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "VpnPluginInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "plugin info instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "nm_vpn_plugin_info_get_plugin" nm_vpn_plugin_info_get_plugin :: 
    Ptr VpnPluginInfo ->                    -- self : TInterface (Name {namespace = "NM", name = "VpnPluginInfo"})
    IO CString

-- | /No description available in the introspection data./
-- 
-- /Since: 1.2/
vpnPluginInfoGetPlugin ::
    (B.CallStack.HasCallStack, MonadIO m, IsVpnPluginInfo a) =>
    a
    -- ^ /@self@/: plugin info instance
    -> m T.Text
    -- ^ __Returns:__ the plugin. Can be 'P.Nothing'.
vpnPluginInfoGetPlugin :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVpnPluginInfo a) =>
a -> m Text
vpnPluginInfoGetPlugin 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 VpnPluginInfo
self' <- a -> IO (Ptr VpnPluginInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr VpnPluginInfo -> IO CString
nm_vpn_plugin_info_get_plugin Ptr VpnPluginInfo
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"vpnPluginInfoGetPlugin" 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 VpnPluginInfoGetPluginMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsVpnPluginInfo a) => O.OverloadedMethod VpnPluginInfoGetPluginMethodInfo a signature where
    overloadedMethod = vpnPluginInfoGetPlugin

instance O.OverloadedMethodInfo VpnPluginInfoGetPluginMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.VpnPluginInfo.vpnPluginInfoGetPlugin",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-VpnPluginInfo.html#v:vpnPluginInfoGetPlugin"
        })


#endif

-- method VpnPluginInfo::get_program
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "VpnPluginInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "plugin info instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "nm_vpn_plugin_info_get_program" nm_vpn_plugin_info_get_program :: 
    Ptr VpnPluginInfo ->                    -- self : TInterface (Name {namespace = "NM", name = "VpnPluginInfo"})
    IO CString

-- | /No description available in the introspection data./
-- 
-- /Since: 1.2/
vpnPluginInfoGetProgram ::
    (B.CallStack.HasCallStack, MonadIO m, IsVpnPluginInfo a) =>
    a
    -- ^ /@self@/: plugin info instance
    -> m T.Text
    -- ^ __Returns:__ the program. Can be 'P.Nothing'.
vpnPluginInfoGetProgram :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVpnPluginInfo a) =>
a -> m Text
vpnPluginInfoGetProgram 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 VpnPluginInfo
self' <- a -> IO (Ptr VpnPluginInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr VpnPluginInfo -> IO CString
nm_vpn_plugin_info_get_program Ptr VpnPluginInfo
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"vpnPluginInfoGetProgram" 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 VpnPluginInfoGetProgramMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsVpnPluginInfo a) => O.OverloadedMethod VpnPluginInfoGetProgramMethodInfo a signature where
    overloadedMethod = vpnPluginInfoGetProgram

instance O.OverloadedMethodInfo VpnPluginInfoGetProgramMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.VpnPluginInfo.vpnPluginInfoGetProgram",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-VpnPluginInfo.html#v:vpnPluginInfoGetProgram"
        })


#endif

-- method VpnPluginInfo::get_service
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "VpnPluginInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "plugin info instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "nm_vpn_plugin_info_get_service" nm_vpn_plugin_info_get_service :: 
    Ptr VpnPluginInfo ->                    -- self : TInterface (Name {namespace = "NM", name = "VpnPluginInfo"})
    IO CString

-- | /No description available in the introspection data./
-- 
-- /Since: 1.4/
vpnPluginInfoGetService ::
    (B.CallStack.HasCallStack, MonadIO m, IsVpnPluginInfo a) =>
    a
    -- ^ /@self@/: plugin info instance
    -> m T.Text
    -- ^ __Returns:__ the service. Cannot be 'P.Nothing'.
vpnPluginInfoGetService :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVpnPluginInfo a) =>
a -> m Text
vpnPluginInfoGetService 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 VpnPluginInfo
self' <- a -> IO (Ptr VpnPluginInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr VpnPluginInfo -> IO CString
nm_vpn_plugin_info_get_service Ptr VpnPluginInfo
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"vpnPluginInfoGetService" 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 VpnPluginInfoGetServiceMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsVpnPluginInfo a) => O.OverloadedMethod VpnPluginInfoGetServiceMethodInfo a signature where
    overloadedMethod = vpnPluginInfoGetService

instance O.OverloadedMethodInfo VpnPluginInfoGetServiceMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.VpnPluginInfo.vpnPluginInfoGetService",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-VpnPluginInfo.html#v:vpnPluginInfoGetService"
        })


#endif

-- method VpnPluginInfo::load_editor_plugin
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "VpnPluginInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "plugin info instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "NM" , name = "VpnEditorPlugin" })
-- throws : True
-- Skip return : False

foreign import ccall "nm_vpn_plugin_info_load_editor_plugin" nm_vpn_plugin_info_load_editor_plugin :: 
    Ptr VpnPluginInfo ->                    -- self : TInterface (Name {namespace = "NM", name = "VpnPluginInfo"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr NM.VpnEditorPlugin.VpnEditorPlugin)

-- | /No description available in the introspection data./
-- 
-- /Since: 1.2/
vpnPluginInfoLoadEditorPlugin ::
    (B.CallStack.HasCallStack, MonadIO m, IsVpnPluginInfo a) =>
    a
    -- ^ /@self@/: plugin info instance
    -> m NM.VpnEditorPlugin.VpnEditorPlugin
    -- ^ __Returns:__ loads the plugin and returns the newly created
    --   instance. The plugin is owned by /@self@/ and can be later retrieved again
    --   via 'GI.NM.Objects.VpnPluginInfo.vpnPluginInfoGetEditorPlugin'. You can load the
    --   plugin only once, unless you reset the state via
    --   'GI.NM.Objects.VpnPluginInfo.vpnPluginInfoSetEditorPlugin'. /(Can throw 'Data.GI.Base.GError.GError')/
vpnPluginInfoLoadEditorPlugin :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVpnPluginInfo a) =>
a -> m VpnEditorPlugin
vpnPluginInfoLoadEditorPlugin a
self = IO VpnEditorPlugin -> m VpnEditorPlugin
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VpnEditorPlugin -> m VpnEditorPlugin)
-> IO VpnEditorPlugin -> m VpnEditorPlugin
forall a b. (a -> b) -> a -> b
$ do
    Ptr VpnPluginInfo
self' <- a -> IO (Ptr VpnPluginInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    IO VpnEditorPlugin -> IO () -> IO VpnEditorPlugin
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr VpnEditorPlugin
result <- (Ptr (Ptr GError) -> IO (Ptr VpnEditorPlugin))
-> IO (Ptr VpnEditorPlugin)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr VpnEditorPlugin))
 -> IO (Ptr VpnEditorPlugin))
-> (Ptr (Ptr GError) -> IO (Ptr VpnEditorPlugin))
-> IO (Ptr VpnEditorPlugin)
forall a b. (a -> b) -> a -> b
$ Ptr VpnPluginInfo -> Ptr (Ptr GError) -> IO (Ptr VpnEditorPlugin)
nm_vpn_plugin_info_load_editor_plugin Ptr VpnPluginInfo
self'
        Text -> Ptr VpnEditorPlugin -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"vpnPluginInfoLoadEditorPlugin" Ptr VpnEditorPlugin
result
        VpnEditorPlugin
result' <- ((ManagedPtr VpnEditorPlugin -> VpnEditorPlugin)
-> Ptr VpnEditorPlugin -> IO VpnEditorPlugin
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr VpnEditorPlugin -> VpnEditorPlugin
NM.VpnEditorPlugin.VpnEditorPlugin) Ptr VpnEditorPlugin
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        VpnEditorPlugin -> IO VpnEditorPlugin
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return VpnEditorPlugin
result'
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data VpnPluginInfoLoadEditorPluginMethodInfo
instance (signature ~ (m NM.VpnEditorPlugin.VpnEditorPlugin), MonadIO m, IsVpnPluginInfo a) => O.OverloadedMethod VpnPluginInfoLoadEditorPluginMethodInfo a signature where
    overloadedMethod = vpnPluginInfoLoadEditorPlugin

instance O.OverloadedMethodInfo VpnPluginInfoLoadEditorPluginMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.VpnPluginInfo.vpnPluginInfoLoadEditorPlugin",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-VpnPluginInfo.html#v:vpnPluginInfoLoadEditorPlugin"
        })


#endif

-- method VpnPluginInfo::lookup_property
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "VpnPluginInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "plugin info instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "group"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "group name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "name of the property"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "nm_vpn_plugin_info_lookup_property" nm_vpn_plugin_info_lookup_property :: 
    Ptr VpnPluginInfo ->                    -- self : TInterface (Name {namespace = "NM", name = "VpnPluginInfo"})
    CString ->                              -- group : TBasicType TUTF8
    CString ->                              -- key : TBasicType TUTF8
    IO CString

-- | /No description available in the introspection data./
-- 
-- /Since: 1.2/
vpnPluginInfoLookupProperty ::
    (B.CallStack.HasCallStack, MonadIO m, IsVpnPluginInfo a) =>
    a
    -- ^ /@self@/: plugin info instance
    -> T.Text
    -- ^ /@group@/: group name
    -> T.Text
    -- ^ /@key@/: name of the property
    -> m T.Text
    -- ^ __Returns:__ t'GI.NM.Objects.VpnPluginInfo.VpnPluginInfo' is internally a t'GI.GLib.Structs.KeyFile.KeyFile'. Returns the matching
    -- property.
vpnPluginInfoLookupProperty :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVpnPluginInfo a) =>
a -> Text -> Text -> m Text
vpnPluginInfoLookupProperty a
self Text
group Text
key = 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 VpnPluginInfo
self' <- a -> IO (Ptr VpnPluginInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
group' <- Text -> IO CString
textToCString Text
group
    CString
key' <- Text -> IO CString
textToCString Text
key
    CString
result <- Ptr VpnPluginInfo -> CString -> CString -> IO CString
nm_vpn_plugin_info_lookup_property Ptr VpnPluginInfo
self' CString
group' CString
key'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"vpnPluginInfoLookupProperty" 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
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
group'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
key'
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data VpnPluginInfoLookupPropertyMethodInfo
instance (signature ~ (T.Text -> T.Text -> m T.Text), MonadIO m, IsVpnPluginInfo a) => O.OverloadedMethod VpnPluginInfoLookupPropertyMethodInfo a signature where
    overloadedMethod = vpnPluginInfoLookupProperty

instance O.OverloadedMethodInfo VpnPluginInfoLookupPropertyMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.VpnPluginInfo.vpnPluginInfoLookupProperty",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-VpnPluginInfo.html#v:vpnPluginInfoLookupProperty"
        })


#endif

-- method VpnPluginInfo::set_editor_plugin
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "VpnPluginInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "plugin info instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "plugin"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "VpnEditorPlugin" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "plugin instance" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "nm_vpn_plugin_info_set_editor_plugin" nm_vpn_plugin_info_set_editor_plugin :: 
    Ptr VpnPluginInfo ->                    -- self : TInterface (Name {namespace = "NM", name = "VpnPluginInfo"})
    Ptr NM.VpnEditorPlugin.VpnEditorPlugin -> -- plugin : TInterface (Name {namespace = "NM", name = "VpnEditorPlugin"})
    IO ()

-- | Set the internal plugin instance. If 'P.Nothing', only clear the previous instance.
-- 
-- /Since: 1.2/
vpnPluginInfoSetEditorPlugin ::
    (B.CallStack.HasCallStack, MonadIO m, IsVpnPluginInfo a, NM.VpnEditorPlugin.IsVpnEditorPlugin b) =>
    a
    -- ^ /@self@/: plugin info instance
    -> Maybe (b)
    -- ^ /@plugin@/: plugin instance
    -> m ()
vpnPluginInfoSetEditorPlugin :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsVpnPluginInfo a,
 IsVpnEditorPlugin b) =>
a -> Maybe b -> m ()
vpnPluginInfoSetEditorPlugin a
self Maybe b
plugin = 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 VpnPluginInfo
self' <- a -> IO (Ptr VpnPluginInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr VpnEditorPlugin
maybePlugin <- case Maybe b
plugin of
        Maybe b
Nothing -> Ptr VpnEditorPlugin -> IO (Ptr VpnEditorPlugin)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr VpnEditorPlugin
forall a. Ptr a
FP.nullPtr
        Just b
jPlugin -> do
            Ptr VpnEditorPlugin
jPlugin' <- b -> IO (Ptr VpnEditorPlugin)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jPlugin
            Ptr VpnEditorPlugin -> IO (Ptr VpnEditorPlugin)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr VpnEditorPlugin
jPlugin'
    Ptr VpnPluginInfo -> Ptr VpnEditorPlugin -> IO ()
nm_vpn_plugin_info_set_editor_plugin Ptr VpnPluginInfo
self' Ptr VpnEditorPlugin
maybePlugin
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
plugin b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data VpnPluginInfoSetEditorPluginMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsVpnPluginInfo a, NM.VpnEditorPlugin.IsVpnEditorPlugin b) => O.OverloadedMethod VpnPluginInfoSetEditorPluginMethodInfo a signature where
    overloadedMethod = vpnPluginInfoSetEditorPlugin

instance O.OverloadedMethodInfo VpnPluginInfoSetEditorPluginMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.VpnPluginInfo.vpnPluginInfoSetEditorPlugin",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-VpnPluginInfo.html#v:vpnPluginInfoSetEditorPlugin"
        })


#endif

-- method VpnPluginInfo::supports_hints
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "VpnPluginInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "plugin info instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "nm_vpn_plugin_info_supports_hints" nm_vpn_plugin_info_supports_hints :: 
    Ptr VpnPluginInfo ->                    -- self : TInterface (Name {namespace = "NM", name = "VpnPluginInfo"})
    IO CInt

-- | /No description available in the introspection data./
-- 
-- /Since: 1.4/
vpnPluginInfoSupportsHints ::
    (B.CallStack.HasCallStack, MonadIO m, IsVpnPluginInfo a) =>
    a
    -- ^ /@self@/: plugin info instance
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the supports hints for secret requests, otherwise 'P.False'
vpnPluginInfoSupportsHints :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVpnPluginInfo a) =>
a -> m Bool
vpnPluginInfoSupportsHints 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 VpnPluginInfo
self' <- a -> IO (Ptr VpnPluginInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr VpnPluginInfo -> IO CInt
nm_vpn_plugin_info_supports_hints Ptr VpnPluginInfo
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 VpnPluginInfoSupportsHintsMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsVpnPluginInfo a) => O.OverloadedMethod VpnPluginInfoSupportsHintsMethodInfo a signature where
    overloadedMethod = vpnPluginInfoSupportsHints

instance O.OverloadedMethodInfo VpnPluginInfoSupportsHintsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.VpnPluginInfo.vpnPluginInfoSupportsHints",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-VpnPluginInfo.html#v:vpnPluginInfoSupportsHints"
        })


#endif

-- method VpnPluginInfo::supports_multiple
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "VpnPluginInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "plugin info instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "nm_vpn_plugin_info_supports_multiple" nm_vpn_plugin_info_supports_multiple :: 
    Ptr VpnPluginInfo ->                    -- self : TInterface (Name {namespace = "NM", name = "VpnPluginInfo"})
    IO CInt

-- | /No description available in the introspection data./
-- 
-- /Since: 1.42/
vpnPluginInfoSupportsMultiple ::
    (B.CallStack.HasCallStack, MonadIO m, IsVpnPluginInfo a) =>
    a
    -- ^ /@self@/: plugin info instance
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the service supports multiple instances with different bus names, otherwise 'P.False'
vpnPluginInfoSupportsMultiple :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVpnPluginInfo a) =>
a -> m Bool
vpnPluginInfoSupportsMultiple 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 VpnPluginInfo
self' <- a -> IO (Ptr VpnPluginInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr VpnPluginInfo -> IO CInt
nm_vpn_plugin_info_supports_multiple Ptr VpnPluginInfo
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 VpnPluginInfoSupportsMultipleMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsVpnPluginInfo a) => O.OverloadedMethod VpnPluginInfoSupportsMultipleMethodInfo a signature where
    overloadedMethod = vpnPluginInfoSupportsMultiple

instance O.OverloadedMethodInfo VpnPluginInfoSupportsMultipleMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.VpnPluginInfo.vpnPluginInfoSupportsMultiple",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-VpnPluginInfo.html#v:vpnPluginInfoSupportsMultiple"
        })


#endif

-- method VpnPluginInfo::list_add
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TGSList
--                 (TInterface Name { namespace = "NM" , name = "VpnPluginInfo" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "list of plugins" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "plugin_info"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "VpnPluginInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "instance to add" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "nm_vpn_plugin_info_list_add" nm_vpn_plugin_info_list_add :: 
    Ptr (GSList (Ptr VpnPluginInfo)) ->     -- list : TGSList (TInterface (Name {namespace = "NM", name = "VpnPluginInfo"}))
    Ptr VpnPluginInfo ->                    -- plugin_info : TInterface (Name {namespace = "NM", name = "VpnPluginInfo"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | /No description available in the introspection data./
-- 
-- /Since: 1.2/
vpnPluginInfoListAdd ::
    (B.CallStack.HasCallStack, MonadIO m, IsVpnPluginInfo a, IsVpnPluginInfo b) =>
    [a]
    -- ^ /@list@/: list of plugins
    -> b
    -- ^ /@pluginInfo@/: instance to add
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
vpnPluginInfoListAdd :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsVpnPluginInfo a, IsVpnPluginInfo b) =>
[a] -> b -> m ()
vpnPluginInfoListAdd [a]
list b
pluginInfo = 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 VpnPluginInfo]
list' <- (a -> IO (Ptr VpnPluginInfo)) -> [a] -> IO [Ptr VpnPluginInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM a -> IO (Ptr VpnPluginInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr [a]
list
    Ptr (GSList (Ptr VpnPluginInfo))
list'' <- [Ptr VpnPluginInfo] -> IO (Ptr (GSList (Ptr VpnPluginInfo)))
forall a. [Ptr a] -> IO (Ptr (GSList (Ptr a)))
packGSList [Ptr VpnPluginInfo]
list'
    Ptr VpnPluginInfo
pluginInfo' <- b -> IO (Ptr VpnPluginInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
pluginInfo
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr (GSList (Ptr VpnPluginInfo))
-> Ptr VpnPluginInfo -> Ptr (Ptr GError) -> IO CInt
nm_vpn_plugin_info_list_add Ptr (GSList (Ptr VpnPluginInfo))
list'' Ptr VpnPluginInfo
pluginInfo'
        (a -> IO ()) -> [a] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [a]
list
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
pluginInfo
        Ptr (GSList (Ptr VpnPluginInfo)) -> IO ()
forall a. Ptr (GSList a) -> IO ()
g_slist_free Ptr (GSList (Ptr VpnPluginInfo))
list''
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        Ptr (GSList (Ptr VpnPluginInfo)) -> IO ()
forall a. Ptr (GSList a) -> IO ()
g_slist_free Ptr (GSList (Ptr VpnPluginInfo))
list''
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method VpnPluginInfo::list_find_by_filename
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TGSList
--                 (TInterface Name { namespace = "NM" , name = "VpnPluginInfo" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "list of plugins" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "filename"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "filename to search" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "NM" , name = "VpnPluginInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "nm_vpn_plugin_info_list_find_by_filename" nm_vpn_plugin_info_list_find_by_filename :: 
    Ptr (GSList (Ptr VpnPluginInfo)) ->     -- list : TGSList (TInterface (Name {namespace = "NM", name = "VpnPluginInfo"}))
    CString ->                              -- filename : TBasicType TUTF8
    IO (Ptr VpnPluginInfo)

-- | /No description available in the introspection data./
-- 
-- /Since: 1.2/
vpnPluginInfoListFindByFilename ::
    (B.CallStack.HasCallStack, MonadIO m, IsVpnPluginInfo a) =>
    [a]
    -- ^ /@list@/: list of plugins
    -> T.Text
    -- ^ /@filename@/: filename to search
    -> m VpnPluginInfo
    -- ^ __Returns:__ the first plugin with a matching /@filename@/ (or 'P.Nothing').
vpnPluginInfoListFindByFilename :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVpnPluginInfo a) =>
[a] -> Text -> m VpnPluginInfo
vpnPluginInfoListFindByFilename [a]
list Text
filename = IO VpnPluginInfo -> m VpnPluginInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VpnPluginInfo -> m VpnPluginInfo)
-> IO VpnPluginInfo -> m VpnPluginInfo
forall a b. (a -> b) -> a -> b
$ do
    [Ptr VpnPluginInfo]
list' <- (a -> IO (Ptr VpnPluginInfo)) -> [a] -> IO [Ptr VpnPluginInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM a -> IO (Ptr VpnPluginInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr [a]
list
    Ptr (GSList (Ptr VpnPluginInfo))
list'' <- [Ptr VpnPluginInfo] -> IO (Ptr (GSList (Ptr VpnPluginInfo)))
forall a. [Ptr a] -> IO (Ptr (GSList (Ptr a)))
packGSList [Ptr VpnPluginInfo]
list'
    CString
filename' <- Text -> IO CString
textToCString Text
filename
    Ptr VpnPluginInfo
result <- Ptr (GSList (Ptr VpnPluginInfo))
-> CString -> IO (Ptr VpnPluginInfo)
nm_vpn_plugin_info_list_find_by_filename Ptr (GSList (Ptr VpnPluginInfo))
list'' CString
filename'
    Text -> Ptr VpnPluginInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"vpnPluginInfoListFindByFilename" Ptr VpnPluginInfo
result
    VpnPluginInfo
result' <- ((ManagedPtr VpnPluginInfo -> VpnPluginInfo)
-> Ptr VpnPluginInfo -> IO VpnPluginInfo
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr VpnPluginInfo -> VpnPluginInfo
VpnPluginInfo) Ptr VpnPluginInfo
result
    (a -> IO ()) -> [a] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [a]
list
    Ptr (GSList (Ptr VpnPluginInfo)) -> IO ()
forall a. Ptr (GSList a) -> IO ()
g_slist_free Ptr (GSList (Ptr VpnPluginInfo))
list''
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
filename'
    VpnPluginInfo -> IO VpnPluginInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return VpnPluginInfo
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method VpnPluginInfo::list_find_by_name
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TGSList
--                 (TInterface Name { namespace = "NM" , name = "VpnPluginInfo" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "list of plugins" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "name to search" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "NM" , name = "VpnPluginInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "nm_vpn_plugin_info_list_find_by_name" nm_vpn_plugin_info_list_find_by_name :: 
    Ptr (GSList (Ptr VpnPluginInfo)) ->     -- list : TGSList (TInterface (Name {namespace = "NM", name = "VpnPluginInfo"}))
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr VpnPluginInfo)

-- | /No description available in the introspection data./
-- 
-- /Since: 1.2/
vpnPluginInfoListFindByName ::
    (B.CallStack.HasCallStack, MonadIO m, IsVpnPluginInfo a) =>
    [a]
    -- ^ /@list@/: list of plugins
    -> T.Text
    -- ^ /@name@/: name to search
    -> m VpnPluginInfo
    -- ^ __Returns:__ the first plugin with a matching /@name@/ (or 'P.Nothing').
vpnPluginInfoListFindByName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVpnPluginInfo a) =>
[a] -> Text -> m VpnPluginInfo
vpnPluginInfoListFindByName [a]
list Text
name = IO VpnPluginInfo -> m VpnPluginInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VpnPluginInfo -> m VpnPluginInfo)
-> IO VpnPluginInfo -> m VpnPluginInfo
forall a b. (a -> b) -> a -> b
$ do
    [Ptr VpnPluginInfo]
list' <- (a -> IO (Ptr VpnPluginInfo)) -> [a] -> IO [Ptr VpnPluginInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM a -> IO (Ptr VpnPluginInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr [a]
list
    Ptr (GSList (Ptr VpnPluginInfo))
list'' <- [Ptr VpnPluginInfo] -> IO (Ptr (GSList (Ptr VpnPluginInfo)))
forall a. [Ptr a] -> IO (Ptr (GSList (Ptr a)))
packGSList [Ptr VpnPluginInfo]
list'
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr VpnPluginInfo
result <- Ptr (GSList (Ptr VpnPluginInfo))
-> CString -> IO (Ptr VpnPluginInfo)
nm_vpn_plugin_info_list_find_by_name Ptr (GSList (Ptr VpnPluginInfo))
list'' CString
name'
    Text -> Ptr VpnPluginInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"vpnPluginInfoListFindByName" Ptr VpnPluginInfo
result
    VpnPluginInfo
result' <- ((ManagedPtr VpnPluginInfo -> VpnPluginInfo)
-> Ptr VpnPluginInfo -> IO VpnPluginInfo
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr VpnPluginInfo -> VpnPluginInfo
VpnPluginInfo) Ptr VpnPluginInfo
result
    (a -> IO ()) -> [a] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [a]
list
    Ptr (GSList (Ptr VpnPluginInfo)) -> IO ()
forall a. Ptr (GSList a) -> IO ()
g_slist_free Ptr (GSList (Ptr VpnPluginInfo))
list''
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    VpnPluginInfo -> IO VpnPluginInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return VpnPluginInfo
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method VpnPluginInfo::list_find_by_service
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TGSList
--                 (TInterface Name { namespace = "NM" , name = "VpnPluginInfo" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "list of plugins" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "service"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "service to search. This can be the main service-type\n  or one of the provided aliases."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "NM" , name = "VpnPluginInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "nm_vpn_plugin_info_list_find_by_service" nm_vpn_plugin_info_list_find_by_service :: 
    Ptr (GSList (Ptr VpnPluginInfo)) ->     -- list : TGSList (TInterface (Name {namespace = "NM", name = "VpnPluginInfo"}))
    CString ->                              -- service : TBasicType TUTF8
    IO (Ptr VpnPluginInfo)

-- | /No description available in the introspection data./
-- 
-- /Since: 1.2/
vpnPluginInfoListFindByService ::
    (B.CallStack.HasCallStack, MonadIO m, IsVpnPluginInfo a) =>
    [a]
    -- ^ /@list@/: list of plugins
    -> T.Text
    -- ^ /@service@/: service to search. This can be the main service-type
    --   or one of the provided aliases.
    -> m VpnPluginInfo
    -- ^ __Returns:__ the first plugin with a matching /@service@/ (or 'P.Nothing').
vpnPluginInfoListFindByService :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVpnPluginInfo a) =>
[a] -> Text -> m VpnPluginInfo
vpnPluginInfoListFindByService [a]
list Text
service = IO VpnPluginInfo -> m VpnPluginInfo
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VpnPluginInfo -> m VpnPluginInfo)
-> IO VpnPluginInfo -> m VpnPluginInfo
forall a b. (a -> b) -> a -> b
$ do
    [Ptr VpnPluginInfo]
list' <- (a -> IO (Ptr VpnPluginInfo)) -> [a] -> IO [Ptr VpnPluginInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM a -> IO (Ptr VpnPluginInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr [a]
list
    Ptr (GSList (Ptr VpnPluginInfo))
list'' <- [Ptr VpnPluginInfo] -> IO (Ptr (GSList (Ptr VpnPluginInfo)))
forall a. [Ptr a] -> IO (Ptr (GSList (Ptr a)))
packGSList [Ptr VpnPluginInfo]
list'
    CString
service' <- Text -> IO CString
textToCString Text
service
    Ptr VpnPluginInfo
result <- Ptr (GSList (Ptr VpnPluginInfo))
-> CString -> IO (Ptr VpnPluginInfo)
nm_vpn_plugin_info_list_find_by_service Ptr (GSList (Ptr VpnPluginInfo))
list'' CString
service'
    Text -> Ptr VpnPluginInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"vpnPluginInfoListFindByService" Ptr VpnPluginInfo
result
    VpnPluginInfo
result' <- ((ManagedPtr VpnPluginInfo -> VpnPluginInfo)
-> Ptr VpnPluginInfo -> IO VpnPluginInfo
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr VpnPluginInfo -> VpnPluginInfo
VpnPluginInfo) Ptr VpnPluginInfo
result
    (a -> IO ()) -> [a] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [a]
list
    Ptr (GSList (Ptr VpnPluginInfo)) -> IO ()
forall a. Ptr (GSList a) -> IO ()
g_slist_free Ptr (GSList (Ptr VpnPluginInfo))
list''
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
service'
    VpnPluginInfo -> IO VpnPluginInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return VpnPluginInfo
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method VpnPluginInfo::list_find_service_type
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TGSList
--                 (TInterface Name { namespace = "NM" , name = "VpnPluginInfo" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a possibly empty #GSList of #NMVpnPluginInfo instances"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a name to lookup the service-type."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "nm_vpn_plugin_info_list_find_service_type" nm_vpn_plugin_info_list_find_service_type :: 
    Ptr (GSList (Ptr VpnPluginInfo)) ->     -- list : TGSList (TInterface (Name {namespace = "NM", name = "VpnPluginInfo"}))
    CString ->                              -- name : TBasicType TUTF8
    IO CString

-- | A VPN plugin provides one or several service-types, like org.freedesktop.NetworkManager.libreswan
-- Certain plugins provide more then one service type, via aliases (org.freedesktop.NetworkManager.openswan).
-- This function looks up a service-type (or an alias) based on a name.
-- 
-- Preferably, the name can be a full service-type\/alias of an installed
-- plugin. Otherwise, it can be the name of a VPN plugin (in which case, the
-- primary, non-aliased service-type is returned). Otherwise, it can be
-- one of several well known short-names (which is a hard-coded list of
-- types in libnm). On success, this returns a full qualified service-type
-- (or an alias). It doesn\'t say, that such an plugin is actually available,
-- but it could be retrieved via 'GI.NM.Objects.VpnPluginInfo.vpnPluginInfoListFindByService'.
-- 
-- /Since: 1.4/
vpnPluginInfoListFindServiceType ::
    (B.CallStack.HasCallStack, MonadIO m, IsVpnPluginInfo a) =>
    [a]
    -- ^ /@list@/: a possibly empty t'GI.GLib.Structs.SList.SList' of t'GI.NM.Objects.VpnPluginInfo.VpnPluginInfo' instances
    -> T.Text
    -- ^ /@name@/: a name to lookup the service-type.
    -> m T.Text
    -- ^ __Returns:__ the resolved service-type or 'P.Nothing' on failure.
vpnPluginInfoListFindServiceType :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVpnPluginInfo a) =>
[a] -> Text -> m Text
vpnPluginInfoListFindServiceType [a]
list Text
name = 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 VpnPluginInfo]
list' <- (a -> IO (Ptr VpnPluginInfo)) -> [a] -> IO [Ptr VpnPluginInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM a -> IO (Ptr VpnPluginInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr [a]
list
    Ptr (GSList (Ptr VpnPluginInfo))
list'' <- [Ptr VpnPluginInfo] -> IO (Ptr (GSList (Ptr VpnPluginInfo)))
forall a. [Ptr a] -> IO (Ptr (GSList (Ptr a)))
packGSList [Ptr VpnPluginInfo]
list'
    CString
name' <- Text -> IO CString
textToCString Text
name
    CString
result <- Ptr (GSList (Ptr VpnPluginInfo)) -> CString -> IO CString
nm_vpn_plugin_info_list_find_service_type Ptr (GSList (Ptr VpnPluginInfo))
list'' CString
name'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"vpnPluginInfoListFindServiceType" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    (a -> IO ()) -> [a] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [a]
list
    Ptr (GSList (Ptr VpnPluginInfo)) -> IO ()
forall a. Ptr (GSList a) -> IO ()
g_slist_free Ptr (GSList (Ptr VpnPluginInfo))
list''
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method VpnPluginInfo::list_get_service_types
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TGSList
--                 (TInterface Name { namespace = "NM" , name = "VpnPluginInfo" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a possibly empty #GSList of #NMVpnPluginInfo"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "only_existing"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "only include results that are actually in @list.\n  Otherwise, the result is extended with a hard-code list or\n  well-known plugins"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "with_abbreviations"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "if %FALSE, only full service types are returned.\n  Otherwise, this also includes abbreviated names that can be used\n  with nm_vpn_plugin_info_list_find_service_type()."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TCArray True (-1) (-1) (TBasicType TUTF8))
-- throws : False
-- Skip return : False

foreign import ccall "nm_vpn_plugin_info_list_get_service_types" nm_vpn_plugin_info_list_get_service_types :: 
    Ptr (GSList (Ptr VpnPluginInfo)) ->     -- list : TGSList (TInterface (Name {namespace = "NM", name = "VpnPluginInfo"}))
    CInt ->                                 -- only_existing : TBasicType TBoolean
    CInt ->                                 -- with_abbreviations : TBasicType TBoolean
    IO (Ptr CString)

-- | /No description available in the introspection data./
-- 
-- /Since: 1.4/
vpnPluginInfoListGetServiceTypes ::
    (B.CallStack.HasCallStack, MonadIO m, IsVpnPluginInfo a) =>
    [a]
    -- ^ /@list@/: a possibly empty t'GI.GLib.Structs.SList.SList' of t'GI.NM.Objects.VpnPluginInfo.VpnPluginInfo'
    -> Bool
    -- ^ /@onlyExisting@/: only include results that are actually in /@list@/.
    --   Otherwise, the result is extended with a hard-code list or
    --   well-known plugins
    -> Bool
    -- ^ /@withAbbreviations@/: if 'P.False', only full service types are returned.
    --   Otherwise, this also includes abbreviated names that can be used
    --   with 'GI.NM.Objects.VpnPluginInfo.vpnPluginInfoListFindServiceType'.
    -> m [T.Text]
    -- ^ __Returns:__ a 'P.Nothing' terminated strv list of strings.
    --   The list itself and the values must be freed with 'GI.GLib.Functions.strfreev'.
vpnPluginInfoListGetServiceTypes :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVpnPluginInfo a) =>
[a] -> Bool -> Bool -> m [Text]
vpnPluginInfoListGetServiceTypes [a]
list Bool
onlyExisting Bool
withAbbreviations = 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 VpnPluginInfo]
list' <- (a -> IO (Ptr VpnPluginInfo)) -> [a] -> IO [Ptr VpnPluginInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM a -> IO (Ptr VpnPluginInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr [a]
list
    Ptr (GSList (Ptr VpnPluginInfo))
list'' <- [Ptr VpnPluginInfo] -> IO (Ptr (GSList (Ptr VpnPluginInfo)))
forall a. [Ptr a] -> IO (Ptr (GSList (Ptr a)))
packGSList [Ptr VpnPluginInfo]
list'
    let onlyExisting' :: CInt
onlyExisting' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
onlyExisting
    let withAbbreviations' :: CInt
withAbbreviations' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
withAbbreviations
    Ptr CString
result <- Ptr (GSList (Ptr VpnPluginInfo))
-> CInt -> CInt -> IO (Ptr CString)
nm_vpn_plugin_info_list_get_service_types Ptr (GSList (Ptr VpnPluginInfo))
list'' CInt
onlyExisting' CInt
withAbbreviations'
    Text -> Ptr CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"vpnPluginInfoListGetServiceTypes" Ptr CString
result
    [Text]
result' <- HasCallStack => Ptr CString -> IO [Text]
Ptr CString -> IO [Text]
unpackZeroTerminatedUTF8CArray Ptr CString
result
    (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
result
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
result
    (a -> IO ()) -> [a] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [a]
list
    Ptr (GSList (Ptr VpnPluginInfo)) -> IO ()
forall a. Ptr (GSList a) -> IO ()
g_slist_free Ptr (GSList (Ptr VpnPluginInfo))
list''
    [Text] -> IO [Text]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method VpnPluginInfo::list_load
-- method type : MemberFunction
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TGSList
--                  (TInterface Name { namespace = "NM" , name = "VpnPluginInfo" }))
-- throws : False
-- Skip return : False

foreign import ccall "nm_vpn_plugin_info_list_load" nm_vpn_plugin_info_list_load :: 
    IO (Ptr (GSList (Ptr VpnPluginInfo)))

-- | /No description available in the introspection data./
-- 
-- /Since: 1.2/
vpnPluginInfoListLoad ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m [VpnPluginInfo]
    -- ^ __Returns:__ list of plugins
    -- loaded from the default directories rejecting duplicates.
vpnPluginInfoListLoad :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
m [VpnPluginInfo]
vpnPluginInfoListLoad  = IO [VpnPluginInfo] -> m [VpnPluginInfo]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [VpnPluginInfo] -> m [VpnPluginInfo])
-> IO [VpnPluginInfo] -> m [VpnPluginInfo]
forall a b. (a -> b) -> a -> b
$ do
    Ptr (GSList (Ptr VpnPluginInfo))
result <- IO (Ptr (GSList (Ptr VpnPluginInfo)))
nm_vpn_plugin_info_list_load
    [Ptr VpnPluginInfo]
result' <- Ptr (GSList (Ptr VpnPluginInfo)) -> IO [Ptr VpnPluginInfo]
forall a. Ptr (GSList (Ptr a)) -> IO [Ptr a]
unpackGSList Ptr (GSList (Ptr VpnPluginInfo))
result
    [VpnPluginInfo]
result'' <- (Ptr VpnPluginInfo -> IO VpnPluginInfo)
-> [Ptr VpnPluginInfo] -> IO [VpnPluginInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ManagedPtr VpnPluginInfo -> VpnPluginInfo)
-> Ptr VpnPluginInfo -> IO VpnPluginInfo
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr VpnPluginInfo -> VpnPluginInfo
VpnPluginInfo) [Ptr VpnPluginInfo]
result'
    Ptr (GSList (Ptr VpnPluginInfo)) -> IO ()
forall a. Ptr (GSList a) -> IO ()
g_slist_free Ptr (GSList (Ptr VpnPluginInfo))
result
    [VpnPluginInfo] -> IO [VpnPluginInfo]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [VpnPluginInfo]
result''

#if defined(ENABLE_OVERLOADING)
#endif

-- method VpnPluginInfo::list_remove
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TGSList
--                 (TInterface Name { namespace = "NM" , name = "VpnPluginInfo" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "list of plugins" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "plugin_info"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "VpnPluginInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "instance" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "nm_vpn_plugin_info_list_remove" nm_vpn_plugin_info_list_remove :: 
    Ptr (GSList (Ptr VpnPluginInfo)) ->     -- list : TGSList (TInterface (Name {namespace = "NM", name = "VpnPluginInfo"}))
    Ptr VpnPluginInfo ->                    -- plugin_info : TInterface (Name {namespace = "NM", name = "VpnPluginInfo"})
    IO CInt

-- | Remove /@pluginInfo@/ from /@list@/.
-- 
-- /Since: 1.2/
vpnPluginInfoListRemove ::
    (B.CallStack.HasCallStack, MonadIO m, IsVpnPluginInfo a, IsVpnPluginInfo b) =>
    [a]
    -- ^ /@list@/: list of plugins
    -> b
    -- ^ /@pluginInfo@/: instance
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@pluginInfo@/ was in /@list@/ and successfully removed.
vpnPluginInfoListRemove :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsVpnPluginInfo a, IsVpnPluginInfo b) =>
[a] -> b -> m Bool
vpnPluginInfoListRemove [a]
list b
pluginInfo = 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 VpnPluginInfo]
list' <- (a -> IO (Ptr VpnPluginInfo)) -> [a] -> IO [Ptr VpnPluginInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM a -> IO (Ptr VpnPluginInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr [a]
list
    Ptr (GSList (Ptr VpnPluginInfo))
list'' <- [Ptr VpnPluginInfo] -> IO (Ptr (GSList (Ptr VpnPluginInfo)))
forall a. [Ptr a] -> IO (Ptr (GSList (Ptr a)))
packGSList [Ptr VpnPluginInfo]
list'
    Ptr VpnPluginInfo
pluginInfo' <- b -> IO (Ptr VpnPluginInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
pluginInfo
    CInt
result <- Ptr (GSList (Ptr VpnPluginInfo)) -> Ptr VpnPluginInfo -> IO CInt
nm_vpn_plugin_info_list_remove Ptr (GSList (Ptr VpnPluginInfo))
list'' Ptr VpnPluginInfo
pluginInfo'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    (a -> IO ()) -> [a] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [a]
list
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
pluginInfo
    Ptr (GSList (Ptr VpnPluginInfo)) -> IO ()
forall a. Ptr (GSList a) -> IO ()
g_slist_free Ptr (GSList (Ptr VpnPluginInfo))
list''
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method VpnPluginInfo::validate_filename
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "filename"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the filename to check"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "nm_vpn_plugin_info_validate_filename" nm_vpn_plugin_info_validate_filename :: 
    CString ->                              -- filename : TBasicType TUTF8
    IO CInt

-- | Regular name files have a certain pattern. That basically means
-- they have the file extension \"name\". Check if /@filename@/
-- is valid according to that pattern.
-- 
-- /Since: 1.2/
vpnPluginInfoValidateFilename ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@filename@/: the filename to check
    -> m Bool
vpnPluginInfoValidateFilename :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Text -> m Bool
vpnPluginInfoValidateFilename Text
filename = 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
    CString
filename' <- Text -> IO CString
textToCString Text
filename
    CInt
result <- CString -> IO CInt
nm_vpn_plugin_info_validate_filename CString
filename'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
filename'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
#endif