{-# LANGUAGE ImplicitParams, RankNTypes, 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./
-- 
-- /Since: 1.2/

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

module GI.NM.Objects.VpnServicePlugin
    ( 

-- * Exported types
    VpnServicePlugin(..)                    ,
    IsVpnServicePlugin                      ,
    toVpnServicePlugin                      ,


 -- * 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"), [disconnect]("GI.NM.Objects.VpnServicePlugin#g:method:disconnect"), [failure]("GI.NM.Objects.VpnServicePlugin#g:method:failure"), [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"), [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"), [secretsRequired]("GI.NM.Objects.VpnServicePlugin#g:method:secretsRequired"), [shutdown]("GI.NM.Objects.VpnServicePlugin#g:method:shutdown"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [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
-- [getConnection]("GI.NM.Objects.VpnServicePlugin#g:method:getConnection"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setConfig]("GI.NM.Objects.VpnServicePlugin#g:method:setConfig"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setIp4Config]("GI.NM.Objects.VpnServicePlugin#g:method:setIp4Config"), [setIp6Config]("GI.NM.Objects.VpnServicePlugin#g:method:setIp6Config"), [setLoginBanner]("GI.NM.Objects.VpnServicePlugin#g:method:setLoginBanner"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveVpnServicePluginMethod           ,
#endif

-- ** disconnect #method:disconnect#

#if defined(ENABLE_OVERLOADING)
    VpnServicePluginDisconnectMethodInfo    ,
#endif
    vpnServicePluginDisconnect              ,


-- ** failure #method:failure#

#if defined(ENABLE_OVERLOADING)
    VpnServicePluginFailureMethodInfo       ,
#endif
    vpnServicePluginFailure                 ,


-- ** getConnection #method:getConnection#

#if defined(ENABLE_OVERLOADING)
    VpnServicePluginGetConnectionMethodInfo ,
#endif
    vpnServicePluginGetConnection           ,


-- ** getSecretFlags #method:getSecretFlags#

    vpnServicePluginGetSecretFlags          ,


-- ** readVpnDetails #method:readVpnDetails#

    vpnServicePluginReadVpnDetails          ,


-- ** secretsRequired #method:secretsRequired#

#if defined(ENABLE_OVERLOADING)
    VpnServicePluginSecretsRequiredMethodInfo,
#endif
    vpnServicePluginSecretsRequired         ,


-- ** setConfig #method:setConfig#

#if defined(ENABLE_OVERLOADING)
    VpnServicePluginSetConfigMethodInfo     ,
#endif
    vpnServicePluginSetConfig               ,


-- ** setIp4Config #method:setIp4Config#

#if defined(ENABLE_OVERLOADING)
    VpnServicePluginSetIp4ConfigMethodInfo  ,
#endif
    vpnServicePluginSetIp4Config            ,


-- ** setIp6Config #method:setIp6Config#

#if defined(ENABLE_OVERLOADING)
    VpnServicePluginSetIp6ConfigMethodInfo  ,
#endif
    vpnServicePluginSetIp6Config            ,


-- ** setLoginBanner #method:setLoginBanner#

#if defined(ENABLE_OVERLOADING)
    VpnServicePluginSetLoginBannerMethodInfo,
#endif
    vpnServicePluginSetLoginBanner          ,


-- ** shutdown #method:shutdown#

#if defined(ENABLE_OVERLOADING)
    VpnServicePluginShutdownMethodInfo      ,
#endif
    vpnServicePluginShutdown                ,




 -- * Properties


-- ** serviceName #attr:serviceName#
-- | The D-Bus service name of this plugin.
-- 
-- /Since: 1.2/

#if defined(ENABLE_OVERLOADING)
    VpnServicePluginServiceNamePropertyInfo ,
#endif
    constructVpnServicePluginServiceName    ,
    getVpnServicePluginServiceName          ,
#if defined(ENABLE_OVERLOADING)
    vpnServicePluginServiceName             ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    VpnServicePluginStatePropertyInfo       ,
#endif
    constructVpnServicePluginState          ,
    getVpnServicePluginState                ,
    setVpnServicePluginState                ,
#if defined(ENABLE_OVERLOADING)
    vpnServicePluginState                   ,
#endif


-- ** watchPeer #attr:watchPeer#
-- | Whether to watch for D-Bus peer\'s changes.
-- 
-- /Since: 1.2/

#if defined(ENABLE_OVERLOADING)
    VpnServicePluginWatchPeerPropertyInfo   ,
#endif
    constructVpnServicePluginWatchPeer      ,
    getVpnServicePluginWatchPeer            ,
#if defined(ENABLE_OVERLOADING)
    vpnServicePluginWatchPeer               ,
#endif




 -- * Signals


-- ** config #signal:config#

    VpnServicePluginConfigCallback          ,
#if defined(ENABLE_OVERLOADING)
    VpnServicePluginConfigSignalInfo        ,
#endif
    afterVpnServicePluginConfig             ,
    onVpnServicePluginConfig                ,


-- ** failure #signal:failure#

    VpnServicePluginFailureCallback         ,
#if defined(ENABLE_OVERLOADING)
    VpnServicePluginFailureSignalInfo       ,
#endif
    afterVpnServicePluginFailure            ,
    onVpnServicePluginFailure               ,


-- ** ip4Config #signal:ip4Config#

    VpnServicePluginIp4ConfigCallback       ,
#if defined(ENABLE_OVERLOADING)
    VpnServicePluginIp4ConfigSignalInfo     ,
#endif
    afterVpnServicePluginIp4Config          ,
    onVpnServicePluginIp4Config             ,


-- ** ip6Config #signal:ip6Config#

    VpnServicePluginIp6ConfigCallback       ,
#if defined(ENABLE_OVERLOADING)
    VpnServicePluginIp6ConfigSignalInfo     ,
#endif
    afterVpnServicePluginIp6Config          ,
    onVpnServicePluginIp6Config             ,


-- ** loginBanner #signal:loginBanner#

    VpnServicePluginLoginBannerCallback     ,
#if defined(ENABLE_OVERLOADING)
    VpnServicePluginLoginBannerSignalInfo   ,
#endif
    afterVpnServicePluginLoginBanner        ,
    onVpnServicePluginLoginBanner           ,


-- ** quit #signal:quit#

    VpnServicePluginQuitCallback            ,
#if defined(ENABLE_OVERLOADING)
    VpnServicePluginQuitSignalInfo          ,
#endif
    afterVpnServicePluginQuit               ,
    onVpnServicePluginQuit                  ,


-- ** secretsRequired #signal:secretsRequired#

    VpnServicePluginSecretsRequiredCallback ,
#if defined(ENABLE_OVERLOADING)
    VpnServicePluginSecretsRequiredSignalInfo,
#endif
    afterVpnServicePluginSecretsRequired    ,
    onVpnServicePluginSecretsRequired       ,


-- ** stateChanged #signal:stateChanged#

    VpnServicePluginStateChangedCallback    ,
#if defined(ENABLE_OVERLOADING)
    VpnServicePluginStateChangedSignalInfo  ,
#endif
    afterVpnServicePluginStateChanged       ,
    onVpnServicePluginStateChanged          ,




    ) 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.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Interfaces.Initable as Gio.Initable
import qualified GI.Gio.Objects.DBusConnection as Gio.DBusConnection
import {-# SOURCE #-} qualified GI.NM.Enums as NM.Enums
import {-# SOURCE #-} qualified GI.NM.Flags as NM.Flags

#else
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Interfaces.Initable as Gio.Initable
import qualified GI.Gio.Objects.DBusConnection as Gio.DBusConnection
import {-# SOURCE #-} qualified GI.NM.Enums as NM.Enums
import {-# SOURCE #-} qualified GI.NM.Flags as NM.Flags

#endif

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

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

foreign import ccall "nm_vpn_service_plugin_get_type"
    c_nm_vpn_service_plugin_get_type :: IO B.Types.GType

instance B.Types.TypedObject VpnServicePlugin where
    glibType :: IO GType
glibType = IO GType
c_nm_vpn_service_plugin_get_type

instance B.Types.GObject VpnServicePlugin

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

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

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

-- | Convert t'VpnServicePlugin' 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 VpnServicePlugin) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_nm_vpn_service_plugin_get_type
    gvalueSet_ :: Ptr GValue -> Maybe VpnServicePlugin -> IO ()
gvalueSet_ Ptr GValue
gv Maybe VpnServicePlugin
P.Nothing = Ptr GValue -> Ptr VpnServicePlugin -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr VpnServicePlugin
forall a. Ptr a
FP.nullPtr :: FP.Ptr VpnServicePlugin)
    gvalueSet_ Ptr GValue
gv (P.Just VpnServicePlugin
obj) = VpnServicePlugin -> (Ptr VpnServicePlugin -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr VpnServicePlugin
obj (Ptr GValue -> Ptr VpnServicePlugin -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe VpnServicePlugin)
gvalueGet_ Ptr GValue
gv = do
        Ptr VpnServicePlugin
ptr <- Ptr GValue -> IO (Ptr VpnServicePlugin)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr VpnServicePlugin)
        if Ptr VpnServicePlugin
ptr Ptr VpnServicePlugin -> Ptr VpnServicePlugin -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr VpnServicePlugin
forall a. Ptr a
FP.nullPtr
        then VpnServicePlugin -> Maybe VpnServicePlugin
forall a. a -> Maybe a
P.Just (VpnServicePlugin -> Maybe VpnServicePlugin)
-> IO VpnServicePlugin -> IO (Maybe VpnServicePlugin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr VpnServicePlugin -> VpnServicePlugin)
-> Ptr VpnServicePlugin -> IO VpnServicePlugin
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr VpnServicePlugin -> VpnServicePlugin
VpnServicePlugin Ptr VpnServicePlugin
ptr
        else Maybe VpnServicePlugin -> IO (Maybe VpnServicePlugin)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe VpnServicePlugin
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveVpnServicePluginMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveVpnServicePluginMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveVpnServicePluginMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveVpnServicePluginMethod "disconnect" o = VpnServicePluginDisconnectMethodInfo
    ResolveVpnServicePluginMethod "failure" o = VpnServicePluginFailureMethodInfo
    ResolveVpnServicePluginMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveVpnServicePluginMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveVpnServicePluginMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveVpnServicePluginMethod "init" o = Gio.Initable.InitableInitMethodInfo
    ResolveVpnServicePluginMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveVpnServicePluginMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveVpnServicePluginMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveVpnServicePluginMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveVpnServicePluginMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveVpnServicePluginMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveVpnServicePluginMethod "secretsRequired" o = VpnServicePluginSecretsRequiredMethodInfo
    ResolveVpnServicePluginMethod "shutdown" o = VpnServicePluginShutdownMethodInfo
    ResolveVpnServicePluginMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveVpnServicePluginMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveVpnServicePluginMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveVpnServicePluginMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveVpnServicePluginMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveVpnServicePluginMethod "getConnection" o = VpnServicePluginGetConnectionMethodInfo
    ResolveVpnServicePluginMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveVpnServicePluginMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveVpnServicePluginMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveVpnServicePluginMethod "setConfig" o = VpnServicePluginSetConfigMethodInfo
    ResolveVpnServicePluginMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveVpnServicePluginMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveVpnServicePluginMethod "setIp4Config" o = VpnServicePluginSetIp4ConfigMethodInfo
    ResolveVpnServicePluginMethod "setIp6Config" o = VpnServicePluginSetIp6ConfigMethodInfo
    ResolveVpnServicePluginMethod "setLoginBanner" o = VpnServicePluginSetLoginBannerMethodInfo
    ResolveVpnServicePluginMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveVpnServicePluginMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- signal VpnServicePlugin::config
-- | /No description available in the introspection data./
type VpnServicePluginConfigCallback =
    GVariant
    -> IO ()

type C_VpnServicePluginConfigCallback =
    Ptr VpnServicePlugin ->                 -- object
    Ptr GVariant ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_VpnServicePluginConfigCallback`.
foreign import ccall "wrapper"
    mk_VpnServicePluginConfigCallback :: C_VpnServicePluginConfigCallback -> IO (FunPtr C_VpnServicePluginConfigCallback)

wrap_VpnServicePluginConfigCallback :: 
    GObject a => (a -> VpnServicePluginConfigCallback) ->
    C_VpnServicePluginConfigCallback
wrap_VpnServicePluginConfigCallback :: forall a.
GObject a =>
(a -> VpnServicePluginConfigCallback)
-> C_VpnServicePluginConfigCallback
wrap_VpnServicePluginConfigCallback a -> VpnServicePluginConfigCallback
gi'cb Ptr VpnServicePlugin
gi'selfPtr Ptr GVariant
object Ptr ()
_ = do
    GVariant
object' <- Ptr GVariant -> IO GVariant
B.GVariant.newGVariantFromPtr Ptr GVariant
object
    Ptr VpnServicePlugin -> (VpnServicePlugin -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr VpnServicePlugin
gi'selfPtr ((VpnServicePlugin -> IO ()) -> IO ())
-> (VpnServicePlugin -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \VpnServicePlugin
gi'self -> a -> VpnServicePluginConfigCallback
gi'cb (VpnServicePlugin -> a
forall a b. Coercible a b => a -> b
Coerce.coerce VpnServicePlugin
gi'self)  GVariant
object'


-- | Connect a signal handler for the [config](#signal:config) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' vpnServicePlugin #config callback
-- @
-- 
-- 
onVpnServicePluginConfig :: (IsVpnServicePlugin a, MonadIO m) => a -> ((?self :: a) => VpnServicePluginConfigCallback) -> m SignalHandlerId
onVpnServicePluginConfig :: forall a (m :: * -> *).
(IsVpnServicePlugin a, MonadIO m) =>
a
-> ((?self::a) => VpnServicePluginConfigCallback)
-> m SignalHandlerId
onVpnServicePluginConfig a
obj (?self::a) => VpnServicePluginConfigCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> VpnServicePluginConfigCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => VpnServicePluginConfigCallback
VpnServicePluginConfigCallback
cb
    let wrapped' :: C_VpnServicePluginConfigCallback
wrapped' = (a -> VpnServicePluginConfigCallback)
-> C_VpnServicePluginConfigCallback
forall a.
GObject a =>
(a -> VpnServicePluginConfigCallback)
-> C_VpnServicePluginConfigCallback
wrap_VpnServicePluginConfigCallback a -> VpnServicePluginConfigCallback
wrapped
    FunPtr C_VpnServicePluginConfigCallback
wrapped'' <- C_VpnServicePluginConfigCallback
-> IO (FunPtr C_VpnServicePluginConfigCallback)
mk_VpnServicePluginConfigCallback C_VpnServicePluginConfigCallback
wrapped'
    a
-> Text
-> FunPtr C_VpnServicePluginConfigCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"config" FunPtr C_VpnServicePluginConfigCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [config](#signal:config) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' vpnServicePlugin #config callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterVpnServicePluginConfig :: (IsVpnServicePlugin a, MonadIO m) => a -> ((?self :: a) => VpnServicePluginConfigCallback) -> m SignalHandlerId
afterVpnServicePluginConfig :: forall a (m :: * -> *).
(IsVpnServicePlugin a, MonadIO m) =>
a
-> ((?self::a) => VpnServicePluginConfigCallback)
-> m SignalHandlerId
afterVpnServicePluginConfig a
obj (?self::a) => VpnServicePluginConfigCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> VpnServicePluginConfigCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => VpnServicePluginConfigCallback
VpnServicePluginConfigCallback
cb
    let wrapped' :: C_VpnServicePluginConfigCallback
wrapped' = (a -> VpnServicePluginConfigCallback)
-> C_VpnServicePluginConfigCallback
forall a.
GObject a =>
(a -> VpnServicePluginConfigCallback)
-> C_VpnServicePluginConfigCallback
wrap_VpnServicePluginConfigCallback a -> VpnServicePluginConfigCallback
wrapped
    FunPtr C_VpnServicePluginConfigCallback
wrapped'' <- C_VpnServicePluginConfigCallback
-> IO (FunPtr C_VpnServicePluginConfigCallback)
mk_VpnServicePluginConfigCallback C_VpnServicePluginConfigCallback
wrapped'
    a
-> Text
-> FunPtr C_VpnServicePluginConfigCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"config" FunPtr C_VpnServicePluginConfigCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data VpnServicePluginConfigSignalInfo
instance SignalInfo VpnServicePluginConfigSignalInfo where
    type HaskellCallbackType VpnServicePluginConfigSignalInfo = VpnServicePluginConfigCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_VpnServicePluginConfigCallback cb
        cb'' <- mk_VpnServicePluginConfigCallback cb'
        connectSignalFunPtr obj "config" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.VpnServicePlugin::config"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-VpnServicePlugin.html#g:signal:config"})

#endif

-- signal VpnServicePlugin::failure
-- | /No description available in the introspection data./
type VpnServicePluginFailureCallback =
    Word32
    -> IO ()

type C_VpnServicePluginFailureCallback =
    Ptr VpnServicePlugin ->                 -- object
    Word32 ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_VpnServicePluginFailureCallback`.
foreign import ccall "wrapper"
    mk_VpnServicePluginFailureCallback :: C_VpnServicePluginFailureCallback -> IO (FunPtr C_VpnServicePluginFailureCallback)

wrap_VpnServicePluginFailureCallback :: 
    GObject a => (a -> VpnServicePluginFailureCallback) ->
    C_VpnServicePluginFailureCallback
wrap_VpnServicePluginFailureCallback :: forall a.
GObject a =>
(a -> VpnServicePluginFailureCallback)
-> C_VpnServicePluginFailureCallback
wrap_VpnServicePluginFailureCallback a -> VpnServicePluginFailureCallback
gi'cb Ptr VpnServicePlugin
gi'selfPtr Word32
object Ptr ()
_ = do
    Ptr VpnServicePlugin -> (VpnServicePlugin -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr VpnServicePlugin
gi'selfPtr ((VpnServicePlugin -> IO ()) -> IO ())
-> (VpnServicePlugin -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \VpnServicePlugin
gi'self -> a -> VpnServicePluginFailureCallback
gi'cb (VpnServicePlugin -> a
forall a b. Coercible a b => a -> b
Coerce.coerce VpnServicePlugin
gi'self)  Word32
object


-- | Connect a signal handler for the [failure](#signal:failure) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' vpnServicePlugin #failure callback
-- @
-- 
-- 
onVpnServicePluginFailure :: (IsVpnServicePlugin a, MonadIO m) => a -> ((?self :: a) => VpnServicePluginFailureCallback) -> m SignalHandlerId
onVpnServicePluginFailure :: forall a (m :: * -> *).
(IsVpnServicePlugin a, MonadIO m) =>
a
-> ((?self::a) => VpnServicePluginFailureCallback)
-> m SignalHandlerId
onVpnServicePluginFailure a
obj (?self::a) => VpnServicePluginFailureCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> VpnServicePluginFailureCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => VpnServicePluginFailureCallback
VpnServicePluginFailureCallback
cb
    let wrapped' :: C_VpnServicePluginFailureCallback
wrapped' = (a -> VpnServicePluginFailureCallback)
-> C_VpnServicePluginFailureCallback
forall a.
GObject a =>
(a -> VpnServicePluginFailureCallback)
-> C_VpnServicePluginFailureCallback
wrap_VpnServicePluginFailureCallback a -> VpnServicePluginFailureCallback
wrapped
    FunPtr C_VpnServicePluginFailureCallback
wrapped'' <- C_VpnServicePluginFailureCallback
-> IO (FunPtr C_VpnServicePluginFailureCallback)
mk_VpnServicePluginFailureCallback C_VpnServicePluginFailureCallback
wrapped'
    a
-> Text
-> FunPtr C_VpnServicePluginFailureCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"failure" FunPtr C_VpnServicePluginFailureCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [failure](#signal:failure) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' vpnServicePlugin #failure callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterVpnServicePluginFailure :: (IsVpnServicePlugin a, MonadIO m) => a -> ((?self :: a) => VpnServicePluginFailureCallback) -> m SignalHandlerId
afterVpnServicePluginFailure :: forall a (m :: * -> *).
(IsVpnServicePlugin a, MonadIO m) =>
a
-> ((?self::a) => VpnServicePluginFailureCallback)
-> m SignalHandlerId
afterVpnServicePluginFailure a
obj (?self::a) => VpnServicePluginFailureCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> VpnServicePluginFailureCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => VpnServicePluginFailureCallback
VpnServicePluginFailureCallback
cb
    let wrapped' :: C_VpnServicePluginFailureCallback
wrapped' = (a -> VpnServicePluginFailureCallback)
-> C_VpnServicePluginFailureCallback
forall a.
GObject a =>
(a -> VpnServicePluginFailureCallback)
-> C_VpnServicePluginFailureCallback
wrap_VpnServicePluginFailureCallback a -> VpnServicePluginFailureCallback
wrapped
    FunPtr C_VpnServicePluginFailureCallback
wrapped'' <- C_VpnServicePluginFailureCallback
-> IO (FunPtr C_VpnServicePluginFailureCallback)
mk_VpnServicePluginFailureCallback C_VpnServicePluginFailureCallback
wrapped'
    a
-> Text
-> FunPtr C_VpnServicePluginFailureCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"failure" FunPtr C_VpnServicePluginFailureCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data VpnServicePluginFailureSignalInfo
instance SignalInfo VpnServicePluginFailureSignalInfo where
    type HaskellCallbackType VpnServicePluginFailureSignalInfo = VpnServicePluginFailureCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_VpnServicePluginFailureCallback cb
        cb'' <- mk_VpnServicePluginFailureCallback cb'
        connectSignalFunPtr obj "failure" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.VpnServicePlugin::failure"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-VpnServicePlugin.html#g:signal:failure"})

#endif

-- signal VpnServicePlugin::ip4-config
-- | /No description available in the introspection data./
type VpnServicePluginIp4ConfigCallback =
    GVariant
    -> IO ()

type C_VpnServicePluginIp4ConfigCallback =
    Ptr VpnServicePlugin ->                 -- object
    Ptr GVariant ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_VpnServicePluginIp4ConfigCallback`.
foreign import ccall "wrapper"
    mk_VpnServicePluginIp4ConfigCallback :: C_VpnServicePluginIp4ConfigCallback -> IO (FunPtr C_VpnServicePluginIp4ConfigCallback)

wrap_VpnServicePluginIp4ConfigCallback :: 
    GObject a => (a -> VpnServicePluginIp4ConfigCallback) ->
    C_VpnServicePluginIp4ConfigCallback
wrap_VpnServicePluginIp4ConfigCallback :: forall a.
GObject a =>
(a -> VpnServicePluginConfigCallback)
-> C_VpnServicePluginConfigCallback
wrap_VpnServicePluginIp4ConfigCallback a -> VpnServicePluginConfigCallback
gi'cb Ptr VpnServicePlugin
gi'selfPtr Ptr GVariant
object Ptr ()
_ = do
    GVariant
object' <- Ptr GVariant -> IO GVariant
B.GVariant.newGVariantFromPtr Ptr GVariant
object
    Ptr VpnServicePlugin -> (VpnServicePlugin -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr VpnServicePlugin
gi'selfPtr ((VpnServicePlugin -> IO ()) -> IO ())
-> (VpnServicePlugin -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \VpnServicePlugin
gi'self -> a -> VpnServicePluginConfigCallback
gi'cb (VpnServicePlugin -> a
forall a b. Coercible a b => a -> b
Coerce.coerce VpnServicePlugin
gi'self)  GVariant
object'


-- | Connect a signal handler for the [ip4Config](#signal:ip4Config) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' vpnServicePlugin #ip4Config callback
-- @
-- 
-- 
onVpnServicePluginIp4Config :: (IsVpnServicePlugin a, MonadIO m) => a -> ((?self :: a) => VpnServicePluginIp4ConfigCallback) -> m SignalHandlerId
onVpnServicePluginIp4Config :: forall a (m :: * -> *).
(IsVpnServicePlugin a, MonadIO m) =>
a
-> ((?self::a) => VpnServicePluginConfigCallback)
-> m SignalHandlerId
onVpnServicePluginIp4Config a
obj (?self::a) => VpnServicePluginConfigCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> VpnServicePluginConfigCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => VpnServicePluginConfigCallback
VpnServicePluginConfigCallback
cb
    let wrapped' :: C_VpnServicePluginConfigCallback
wrapped' = (a -> VpnServicePluginConfigCallback)
-> C_VpnServicePluginConfigCallback
forall a.
GObject a =>
(a -> VpnServicePluginConfigCallback)
-> C_VpnServicePluginConfigCallback
wrap_VpnServicePluginIp4ConfigCallback a -> VpnServicePluginConfigCallback
wrapped
    FunPtr C_VpnServicePluginConfigCallback
wrapped'' <- C_VpnServicePluginConfigCallback
-> IO (FunPtr C_VpnServicePluginConfigCallback)
mk_VpnServicePluginIp4ConfigCallback C_VpnServicePluginConfigCallback
wrapped'
    a
-> Text
-> FunPtr C_VpnServicePluginConfigCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"ip4-config" FunPtr C_VpnServicePluginConfigCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [ip4Config](#signal:ip4Config) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' vpnServicePlugin #ip4Config callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterVpnServicePluginIp4Config :: (IsVpnServicePlugin a, MonadIO m) => a -> ((?self :: a) => VpnServicePluginIp4ConfigCallback) -> m SignalHandlerId
afterVpnServicePluginIp4Config :: forall a (m :: * -> *).
(IsVpnServicePlugin a, MonadIO m) =>
a
-> ((?self::a) => VpnServicePluginConfigCallback)
-> m SignalHandlerId
afterVpnServicePluginIp4Config a
obj (?self::a) => VpnServicePluginConfigCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> VpnServicePluginConfigCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => VpnServicePluginConfigCallback
VpnServicePluginConfigCallback
cb
    let wrapped' :: C_VpnServicePluginConfigCallback
wrapped' = (a -> VpnServicePluginConfigCallback)
-> C_VpnServicePluginConfigCallback
forall a.
GObject a =>
(a -> VpnServicePluginConfigCallback)
-> C_VpnServicePluginConfigCallback
wrap_VpnServicePluginIp4ConfigCallback a -> VpnServicePluginConfigCallback
wrapped
    FunPtr C_VpnServicePluginConfigCallback
wrapped'' <- C_VpnServicePluginConfigCallback
-> IO (FunPtr C_VpnServicePluginConfigCallback)
mk_VpnServicePluginIp4ConfigCallback C_VpnServicePluginConfigCallback
wrapped'
    a
-> Text
-> FunPtr C_VpnServicePluginConfigCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"ip4-config" FunPtr C_VpnServicePluginConfigCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data VpnServicePluginIp4ConfigSignalInfo
instance SignalInfo VpnServicePluginIp4ConfigSignalInfo where
    type HaskellCallbackType VpnServicePluginIp4ConfigSignalInfo = VpnServicePluginIp4ConfigCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_VpnServicePluginIp4ConfigCallback cb
        cb'' <- mk_VpnServicePluginIp4ConfigCallback cb'
        connectSignalFunPtr obj "ip4-config" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.VpnServicePlugin::ip4-config"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-VpnServicePlugin.html#g:signal:ip4Config"})

#endif

-- signal VpnServicePlugin::ip6-config
-- | /No description available in the introspection data./
type VpnServicePluginIp6ConfigCallback =
    GVariant
    -> IO ()

type C_VpnServicePluginIp6ConfigCallback =
    Ptr VpnServicePlugin ->                 -- object
    Ptr GVariant ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_VpnServicePluginIp6ConfigCallback`.
foreign import ccall "wrapper"
    mk_VpnServicePluginIp6ConfigCallback :: C_VpnServicePluginIp6ConfigCallback -> IO (FunPtr C_VpnServicePluginIp6ConfigCallback)

wrap_VpnServicePluginIp6ConfigCallback :: 
    GObject a => (a -> VpnServicePluginIp6ConfigCallback) ->
    C_VpnServicePluginIp6ConfigCallback
wrap_VpnServicePluginIp6ConfigCallback :: forall a.
GObject a =>
(a -> VpnServicePluginConfigCallback)
-> C_VpnServicePluginConfigCallback
wrap_VpnServicePluginIp6ConfigCallback a -> VpnServicePluginConfigCallback
gi'cb Ptr VpnServicePlugin
gi'selfPtr Ptr GVariant
object Ptr ()
_ = do
    GVariant
object' <- Ptr GVariant -> IO GVariant
B.GVariant.newGVariantFromPtr Ptr GVariant
object
    Ptr VpnServicePlugin -> (VpnServicePlugin -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr VpnServicePlugin
gi'selfPtr ((VpnServicePlugin -> IO ()) -> IO ())
-> (VpnServicePlugin -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \VpnServicePlugin
gi'self -> a -> VpnServicePluginConfigCallback
gi'cb (VpnServicePlugin -> a
forall a b. Coercible a b => a -> b
Coerce.coerce VpnServicePlugin
gi'self)  GVariant
object'


-- | Connect a signal handler for the [ip6Config](#signal:ip6Config) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' vpnServicePlugin #ip6Config callback
-- @
-- 
-- 
onVpnServicePluginIp6Config :: (IsVpnServicePlugin a, MonadIO m) => a -> ((?self :: a) => VpnServicePluginIp6ConfigCallback) -> m SignalHandlerId
onVpnServicePluginIp6Config :: forall a (m :: * -> *).
(IsVpnServicePlugin a, MonadIO m) =>
a
-> ((?self::a) => VpnServicePluginConfigCallback)
-> m SignalHandlerId
onVpnServicePluginIp6Config a
obj (?self::a) => VpnServicePluginConfigCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> VpnServicePluginConfigCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => VpnServicePluginConfigCallback
VpnServicePluginConfigCallback
cb
    let wrapped' :: C_VpnServicePluginConfigCallback
wrapped' = (a -> VpnServicePluginConfigCallback)
-> C_VpnServicePluginConfigCallback
forall a.
GObject a =>
(a -> VpnServicePluginConfigCallback)
-> C_VpnServicePluginConfigCallback
wrap_VpnServicePluginIp6ConfigCallback a -> VpnServicePluginConfigCallback
wrapped
    FunPtr C_VpnServicePluginConfigCallback
wrapped'' <- C_VpnServicePluginConfigCallback
-> IO (FunPtr C_VpnServicePluginConfigCallback)
mk_VpnServicePluginIp6ConfigCallback C_VpnServicePluginConfigCallback
wrapped'
    a
-> Text
-> FunPtr C_VpnServicePluginConfigCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"ip6-config" FunPtr C_VpnServicePluginConfigCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [ip6Config](#signal:ip6Config) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' vpnServicePlugin #ip6Config callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterVpnServicePluginIp6Config :: (IsVpnServicePlugin a, MonadIO m) => a -> ((?self :: a) => VpnServicePluginIp6ConfigCallback) -> m SignalHandlerId
afterVpnServicePluginIp6Config :: forall a (m :: * -> *).
(IsVpnServicePlugin a, MonadIO m) =>
a
-> ((?self::a) => VpnServicePluginConfigCallback)
-> m SignalHandlerId
afterVpnServicePluginIp6Config a
obj (?self::a) => VpnServicePluginConfigCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> VpnServicePluginConfigCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => VpnServicePluginConfigCallback
VpnServicePluginConfigCallback
cb
    let wrapped' :: C_VpnServicePluginConfigCallback
wrapped' = (a -> VpnServicePluginConfigCallback)
-> C_VpnServicePluginConfigCallback
forall a.
GObject a =>
(a -> VpnServicePluginConfigCallback)
-> C_VpnServicePluginConfigCallback
wrap_VpnServicePluginIp6ConfigCallback a -> VpnServicePluginConfigCallback
wrapped
    FunPtr C_VpnServicePluginConfigCallback
wrapped'' <- C_VpnServicePluginConfigCallback
-> IO (FunPtr C_VpnServicePluginConfigCallback)
mk_VpnServicePluginIp6ConfigCallback C_VpnServicePluginConfigCallback
wrapped'
    a
-> Text
-> FunPtr C_VpnServicePluginConfigCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"ip6-config" FunPtr C_VpnServicePluginConfigCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data VpnServicePluginIp6ConfigSignalInfo
instance SignalInfo VpnServicePluginIp6ConfigSignalInfo where
    type HaskellCallbackType VpnServicePluginIp6ConfigSignalInfo = VpnServicePluginIp6ConfigCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_VpnServicePluginIp6ConfigCallback cb
        cb'' <- mk_VpnServicePluginIp6ConfigCallback cb'
        connectSignalFunPtr obj "ip6-config" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.VpnServicePlugin::ip6-config"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-VpnServicePlugin.html#g:signal:ip6Config"})

#endif

-- signal VpnServicePlugin::login-banner
-- | /No description available in the introspection data./
type VpnServicePluginLoginBannerCallback =
    T.Text
    -> IO ()

type C_VpnServicePluginLoginBannerCallback =
    Ptr VpnServicePlugin ->                 -- object
    CString ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_VpnServicePluginLoginBannerCallback`.
foreign import ccall "wrapper"
    mk_VpnServicePluginLoginBannerCallback :: C_VpnServicePluginLoginBannerCallback -> IO (FunPtr C_VpnServicePluginLoginBannerCallback)

wrap_VpnServicePluginLoginBannerCallback :: 
    GObject a => (a -> VpnServicePluginLoginBannerCallback) ->
    C_VpnServicePluginLoginBannerCallback
wrap_VpnServicePluginLoginBannerCallback :: forall a.
GObject a =>
(a -> VpnServicePluginLoginBannerCallback)
-> C_VpnServicePluginLoginBannerCallback
wrap_VpnServicePluginLoginBannerCallback a -> VpnServicePluginLoginBannerCallback
gi'cb Ptr VpnServicePlugin
gi'selfPtr CString
object Ptr ()
_ = do
    Text
object' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
object
    Ptr VpnServicePlugin -> (VpnServicePlugin -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr VpnServicePlugin
gi'selfPtr ((VpnServicePlugin -> IO ()) -> IO ())
-> (VpnServicePlugin -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \VpnServicePlugin
gi'self -> a -> VpnServicePluginLoginBannerCallback
gi'cb (VpnServicePlugin -> a
forall a b. Coercible a b => a -> b
Coerce.coerce VpnServicePlugin
gi'self)  Text
object'


-- | Connect a signal handler for the [loginBanner](#signal:loginBanner) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' vpnServicePlugin #loginBanner callback
-- @
-- 
-- 
onVpnServicePluginLoginBanner :: (IsVpnServicePlugin a, MonadIO m) => a -> ((?self :: a) => VpnServicePluginLoginBannerCallback) -> m SignalHandlerId
onVpnServicePluginLoginBanner :: forall a (m :: * -> *).
(IsVpnServicePlugin a, MonadIO m) =>
a
-> ((?self::a) => VpnServicePluginLoginBannerCallback)
-> m SignalHandlerId
onVpnServicePluginLoginBanner a
obj (?self::a) => VpnServicePluginLoginBannerCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> VpnServicePluginLoginBannerCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => VpnServicePluginLoginBannerCallback
VpnServicePluginLoginBannerCallback
cb
    let wrapped' :: C_VpnServicePluginLoginBannerCallback
wrapped' = (a -> VpnServicePluginLoginBannerCallback)
-> C_VpnServicePluginLoginBannerCallback
forall a.
GObject a =>
(a -> VpnServicePluginLoginBannerCallback)
-> C_VpnServicePluginLoginBannerCallback
wrap_VpnServicePluginLoginBannerCallback a -> VpnServicePluginLoginBannerCallback
wrapped
    FunPtr C_VpnServicePluginLoginBannerCallback
wrapped'' <- C_VpnServicePluginLoginBannerCallback
-> IO (FunPtr C_VpnServicePluginLoginBannerCallback)
mk_VpnServicePluginLoginBannerCallback C_VpnServicePluginLoginBannerCallback
wrapped'
    a
-> Text
-> FunPtr C_VpnServicePluginLoginBannerCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"login-banner" FunPtr C_VpnServicePluginLoginBannerCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [loginBanner](#signal:loginBanner) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' vpnServicePlugin #loginBanner callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterVpnServicePluginLoginBanner :: (IsVpnServicePlugin a, MonadIO m) => a -> ((?self :: a) => VpnServicePluginLoginBannerCallback) -> m SignalHandlerId
afterVpnServicePluginLoginBanner :: forall a (m :: * -> *).
(IsVpnServicePlugin a, MonadIO m) =>
a
-> ((?self::a) => VpnServicePluginLoginBannerCallback)
-> m SignalHandlerId
afterVpnServicePluginLoginBanner a
obj (?self::a) => VpnServicePluginLoginBannerCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> VpnServicePluginLoginBannerCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => VpnServicePluginLoginBannerCallback
VpnServicePluginLoginBannerCallback
cb
    let wrapped' :: C_VpnServicePluginLoginBannerCallback
wrapped' = (a -> VpnServicePluginLoginBannerCallback)
-> C_VpnServicePluginLoginBannerCallback
forall a.
GObject a =>
(a -> VpnServicePluginLoginBannerCallback)
-> C_VpnServicePluginLoginBannerCallback
wrap_VpnServicePluginLoginBannerCallback a -> VpnServicePluginLoginBannerCallback
wrapped
    FunPtr C_VpnServicePluginLoginBannerCallback
wrapped'' <- C_VpnServicePluginLoginBannerCallback
-> IO (FunPtr C_VpnServicePluginLoginBannerCallback)
mk_VpnServicePluginLoginBannerCallback C_VpnServicePluginLoginBannerCallback
wrapped'
    a
-> Text
-> FunPtr C_VpnServicePluginLoginBannerCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"login-banner" FunPtr C_VpnServicePluginLoginBannerCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data VpnServicePluginLoginBannerSignalInfo
instance SignalInfo VpnServicePluginLoginBannerSignalInfo where
    type HaskellCallbackType VpnServicePluginLoginBannerSignalInfo = VpnServicePluginLoginBannerCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_VpnServicePluginLoginBannerCallback cb
        cb'' <- mk_VpnServicePluginLoginBannerCallback cb'
        connectSignalFunPtr obj "login-banner" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.VpnServicePlugin::login-banner"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-VpnServicePlugin.html#g:signal:loginBanner"})

#endif

-- signal VpnServicePlugin::quit
-- | /No description available in the introspection data./
type VpnServicePluginQuitCallback =
    IO ()

type C_VpnServicePluginQuitCallback =
    Ptr VpnServicePlugin ->                 -- object
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_VpnServicePluginQuitCallback`.
foreign import ccall "wrapper"
    mk_VpnServicePluginQuitCallback :: C_VpnServicePluginQuitCallback -> IO (FunPtr C_VpnServicePluginQuitCallback)

wrap_VpnServicePluginQuitCallback :: 
    GObject a => (a -> VpnServicePluginQuitCallback) ->
    C_VpnServicePluginQuitCallback
wrap_VpnServicePluginQuitCallback :: forall a.
GObject a =>
(a -> IO ()) -> C_VpnServicePluginQuitCallback
wrap_VpnServicePluginQuitCallback a -> IO ()
gi'cb Ptr VpnServicePlugin
gi'selfPtr Ptr ()
_ = do
    Ptr VpnServicePlugin -> (VpnServicePlugin -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr VpnServicePlugin
gi'selfPtr ((VpnServicePlugin -> IO ()) -> IO ())
-> (VpnServicePlugin -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \VpnServicePlugin
gi'self -> a -> IO ()
gi'cb (VpnServicePlugin -> a
forall a b. Coercible a b => a -> b
Coerce.coerce VpnServicePlugin
gi'self) 


-- | Connect a signal handler for the [quit](#signal:quit) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' vpnServicePlugin #quit callback
-- @
-- 
-- 
onVpnServicePluginQuit :: (IsVpnServicePlugin a, MonadIO m) => a -> ((?self :: a) => VpnServicePluginQuitCallback) -> m SignalHandlerId
onVpnServicePluginQuit :: forall a (m :: * -> *).
(IsVpnServicePlugin a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onVpnServicePluginQuit a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_VpnServicePluginQuitCallback
wrapped' = (a -> IO ()) -> C_VpnServicePluginQuitCallback
forall a.
GObject a =>
(a -> IO ()) -> C_VpnServicePluginQuitCallback
wrap_VpnServicePluginQuitCallback a -> IO ()
wrapped
    FunPtr C_VpnServicePluginQuitCallback
wrapped'' <- C_VpnServicePluginQuitCallback
-> IO (FunPtr C_VpnServicePluginQuitCallback)
mk_VpnServicePluginQuitCallback C_VpnServicePluginQuitCallback
wrapped'
    a
-> Text
-> FunPtr C_VpnServicePluginQuitCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"quit" FunPtr C_VpnServicePluginQuitCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [quit](#signal:quit) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' vpnServicePlugin #quit callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterVpnServicePluginQuit :: (IsVpnServicePlugin a, MonadIO m) => a -> ((?self :: a) => VpnServicePluginQuitCallback) -> m SignalHandlerId
afterVpnServicePluginQuit :: forall a (m :: * -> *).
(IsVpnServicePlugin a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterVpnServicePluginQuit a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_VpnServicePluginQuitCallback
wrapped' = (a -> IO ()) -> C_VpnServicePluginQuitCallback
forall a.
GObject a =>
(a -> IO ()) -> C_VpnServicePluginQuitCallback
wrap_VpnServicePluginQuitCallback a -> IO ()
wrapped
    FunPtr C_VpnServicePluginQuitCallback
wrapped'' <- C_VpnServicePluginQuitCallback
-> IO (FunPtr C_VpnServicePluginQuitCallback)
mk_VpnServicePluginQuitCallback C_VpnServicePluginQuitCallback
wrapped'
    a
-> Text
-> FunPtr C_VpnServicePluginQuitCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"quit" FunPtr C_VpnServicePluginQuitCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data VpnServicePluginQuitSignalInfo
instance SignalInfo VpnServicePluginQuitSignalInfo where
    type HaskellCallbackType VpnServicePluginQuitSignalInfo = VpnServicePluginQuitCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_VpnServicePluginQuitCallback cb
        cb'' <- mk_VpnServicePluginQuitCallback cb'
        connectSignalFunPtr obj "quit" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.VpnServicePlugin::quit"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-VpnServicePlugin.html#g:signal:quit"})

#endif

-- signal VpnServicePlugin::secrets-required
-- | /No description available in the introspection data./
type VpnServicePluginSecretsRequiredCallback =
    T.Text
    -> [T.Text]
    -> IO ()

type C_VpnServicePluginSecretsRequiredCallback =
    Ptr VpnServicePlugin ->                 -- object
    CString ->
    Ptr CString ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_VpnServicePluginSecretsRequiredCallback`.
foreign import ccall "wrapper"
    mk_VpnServicePluginSecretsRequiredCallback :: C_VpnServicePluginSecretsRequiredCallback -> IO (FunPtr C_VpnServicePluginSecretsRequiredCallback)

wrap_VpnServicePluginSecretsRequiredCallback :: 
    GObject a => (a -> VpnServicePluginSecretsRequiredCallback) ->
    C_VpnServicePluginSecretsRequiredCallback
wrap_VpnServicePluginSecretsRequiredCallback :: forall a.
GObject a =>
(a -> VpnServicePluginSecretsRequiredCallback)
-> C_VpnServicePluginSecretsRequiredCallback
wrap_VpnServicePluginSecretsRequiredCallback a -> VpnServicePluginSecretsRequiredCallback
gi'cb Ptr VpnServicePlugin
gi'selfPtr CString
object Ptr CString
p0 Ptr ()
_ = do
    Text
object' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
object
    [Text]
p0' <- HasCallStack => Ptr CString -> IO [Text]
Ptr CString -> IO [Text]
unpackZeroTerminatedUTF8CArray Ptr CString
p0
    Ptr VpnServicePlugin -> (VpnServicePlugin -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr VpnServicePlugin
gi'selfPtr ((VpnServicePlugin -> IO ()) -> IO ())
-> (VpnServicePlugin -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \VpnServicePlugin
gi'self -> a -> VpnServicePluginSecretsRequiredCallback
gi'cb (VpnServicePlugin -> a
forall a b. Coercible a b => a -> b
Coerce.coerce VpnServicePlugin
gi'self)  Text
object' [Text]
p0'


-- | Connect a signal handler for the [secretsRequired](#signal:secretsRequired) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' vpnServicePlugin #secretsRequired callback
-- @
-- 
-- 
onVpnServicePluginSecretsRequired :: (IsVpnServicePlugin a, MonadIO m) => a -> ((?self :: a) => VpnServicePluginSecretsRequiredCallback) -> m SignalHandlerId
onVpnServicePluginSecretsRequired :: forall a (m :: * -> *).
(IsVpnServicePlugin a, MonadIO m) =>
a
-> ((?self::a) => VpnServicePluginSecretsRequiredCallback)
-> m SignalHandlerId
onVpnServicePluginSecretsRequired a
obj (?self::a) => VpnServicePluginSecretsRequiredCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> VpnServicePluginSecretsRequiredCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => VpnServicePluginSecretsRequiredCallback
VpnServicePluginSecretsRequiredCallback
cb
    let wrapped' :: C_VpnServicePluginSecretsRequiredCallback
wrapped' = (a -> VpnServicePluginSecretsRequiredCallback)
-> C_VpnServicePluginSecretsRequiredCallback
forall a.
GObject a =>
(a -> VpnServicePluginSecretsRequiredCallback)
-> C_VpnServicePluginSecretsRequiredCallback
wrap_VpnServicePluginSecretsRequiredCallback a -> VpnServicePluginSecretsRequiredCallback
wrapped
    FunPtr C_VpnServicePluginSecretsRequiredCallback
wrapped'' <- C_VpnServicePluginSecretsRequiredCallback
-> IO (FunPtr C_VpnServicePluginSecretsRequiredCallback)
mk_VpnServicePluginSecretsRequiredCallback C_VpnServicePluginSecretsRequiredCallback
wrapped'
    a
-> Text
-> FunPtr C_VpnServicePluginSecretsRequiredCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"secrets-required" FunPtr C_VpnServicePluginSecretsRequiredCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [secretsRequired](#signal:secretsRequired) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' vpnServicePlugin #secretsRequired callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterVpnServicePluginSecretsRequired :: (IsVpnServicePlugin a, MonadIO m) => a -> ((?self :: a) => VpnServicePluginSecretsRequiredCallback) -> m SignalHandlerId
afterVpnServicePluginSecretsRequired :: forall a (m :: * -> *).
(IsVpnServicePlugin a, MonadIO m) =>
a
-> ((?self::a) => VpnServicePluginSecretsRequiredCallback)
-> m SignalHandlerId
afterVpnServicePluginSecretsRequired a
obj (?self::a) => VpnServicePluginSecretsRequiredCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> VpnServicePluginSecretsRequiredCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => VpnServicePluginSecretsRequiredCallback
VpnServicePluginSecretsRequiredCallback
cb
    let wrapped' :: C_VpnServicePluginSecretsRequiredCallback
wrapped' = (a -> VpnServicePluginSecretsRequiredCallback)
-> C_VpnServicePluginSecretsRequiredCallback
forall a.
GObject a =>
(a -> VpnServicePluginSecretsRequiredCallback)
-> C_VpnServicePluginSecretsRequiredCallback
wrap_VpnServicePluginSecretsRequiredCallback a -> VpnServicePluginSecretsRequiredCallback
wrapped
    FunPtr C_VpnServicePluginSecretsRequiredCallback
wrapped'' <- C_VpnServicePluginSecretsRequiredCallback
-> IO (FunPtr C_VpnServicePluginSecretsRequiredCallback)
mk_VpnServicePluginSecretsRequiredCallback C_VpnServicePluginSecretsRequiredCallback
wrapped'
    a
-> Text
-> FunPtr C_VpnServicePluginSecretsRequiredCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"secrets-required" FunPtr C_VpnServicePluginSecretsRequiredCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data VpnServicePluginSecretsRequiredSignalInfo
instance SignalInfo VpnServicePluginSecretsRequiredSignalInfo where
    type HaskellCallbackType VpnServicePluginSecretsRequiredSignalInfo = VpnServicePluginSecretsRequiredCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_VpnServicePluginSecretsRequiredCallback cb
        cb'' <- mk_VpnServicePluginSecretsRequiredCallback cb'
        connectSignalFunPtr obj "secrets-required" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.VpnServicePlugin::secrets-required"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-VpnServicePlugin.html#g:signal:secretsRequired"})

#endif

-- signal VpnServicePlugin::state-changed
-- | /No description available in the introspection data./
type VpnServicePluginStateChangedCallback =
    Word32
    -> IO ()

type C_VpnServicePluginStateChangedCallback =
    Ptr VpnServicePlugin ->                 -- object
    Word32 ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_VpnServicePluginStateChangedCallback`.
foreign import ccall "wrapper"
    mk_VpnServicePluginStateChangedCallback :: C_VpnServicePluginStateChangedCallback -> IO (FunPtr C_VpnServicePluginStateChangedCallback)

wrap_VpnServicePluginStateChangedCallback :: 
    GObject a => (a -> VpnServicePluginStateChangedCallback) ->
    C_VpnServicePluginStateChangedCallback
wrap_VpnServicePluginStateChangedCallback :: forall a.
GObject a =>
(a -> VpnServicePluginFailureCallback)
-> C_VpnServicePluginFailureCallback
wrap_VpnServicePluginStateChangedCallback a -> VpnServicePluginFailureCallback
gi'cb Ptr VpnServicePlugin
gi'selfPtr Word32
object Ptr ()
_ = do
    Ptr VpnServicePlugin -> (VpnServicePlugin -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr VpnServicePlugin
gi'selfPtr ((VpnServicePlugin -> IO ()) -> IO ())
-> (VpnServicePlugin -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \VpnServicePlugin
gi'self -> a -> VpnServicePluginFailureCallback
gi'cb (VpnServicePlugin -> a
forall a b. Coercible a b => a -> b
Coerce.coerce VpnServicePlugin
gi'self)  Word32
object


-- | Connect a signal handler for the [stateChanged](#signal:stateChanged) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' vpnServicePlugin #stateChanged callback
-- @
-- 
-- 
onVpnServicePluginStateChanged :: (IsVpnServicePlugin a, MonadIO m) => a -> ((?self :: a) => VpnServicePluginStateChangedCallback) -> m SignalHandlerId
onVpnServicePluginStateChanged :: forall a (m :: * -> *).
(IsVpnServicePlugin a, MonadIO m) =>
a
-> ((?self::a) => VpnServicePluginFailureCallback)
-> m SignalHandlerId
onVpnServicePluginStateChanged a
obj (?self::a) => VpnServicePluginFailureCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> VpnServicePluginFailureCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => VpnServicePluginFailureCallback
VpnServicePluginFailureCallback
cb
    let wrapped' :: C_VpnServicePluginFailureCallback
wrapped' = (a -> VpnServicePluginFailureCallback)
-> C_VpnServicePluginFailureCallback
forall a.
GObject a =>
(a -> VpnServicePluginFailureCallback)
-> C_VpnServicePluginFailureCallback
wrap_VpnServicePluginStateChangedCallback a -> VpnServicePluginFailureCallback
wrapped
    FunPtr C_VpnServicePluginFailureCallback
wrapped'' <- C_VpnServicePluginFailureCallback
-> IO (FunPtr C_VpnServicePluginFailureCallback)
mk_VpnServicePluginStateChangedCallback C_VpnServicePluginFailureCallback
wrapped'
    a
-> Text
-> FunPtr C_VpnServicePluginFailureCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"state-changed" FunPtr C_VpnServicePluginFailureCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [stateChanged](#signal:stateChanged) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' vpnServicePlugin #stateChanged callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterVpnServicePluginStateChanged :: (IsVpnServicePlugin a, MonadIO m) => a -> ((?self :: a) => VpnServicePluginStateChangedCallback) -> m SignalHandlerId
afterVpnServicePluginStateChanged :: forall a (m :: * -> *).
(IsVpnServicePlugin a, MonadIO m) =>
a
-> ((?self::a) => VpnServicePluginFailureCallback)
-> m SignalHandlerId
afterVpnServicePluginStateChanged a
obj (?self::a) => VpnServicePluginFailureCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> VpnServicePluginFailureCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => VpnServicePluginFailureCallback
VpnServicePluginFailureCallback
cb
    let wrapped' :: C_VpnServicePluginFailureCallback
wrapped' = (a -> VpnServicePluginFailureCallback)
-> C_VpnServicePluginFailureCallback
forall a.
GObject a =>
(a -> VpnServicePluginFailureCallback)
-> C_VpnServicePluginFailureCallback
wrap_VpnServicePluginStateChangedCallback a -> VpnServicePluginFailureCallback
wrapped
    FunPtr C_VpnServicePluginFailureCallback
wrapped'' <- C_VpnServicePluginFailureCallback
-> IO (FunPtr C_VpnServicePluginFailureCallback)
mk_VpnServicePluginStateChangedCallback C_VpnServicePluginFailureCallback
wrapped'
    a
-> Text
-> FunPtr C_VpnServicePluginFailureCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"state-changed" FunPtr C_VpnServicePluginFailureCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data VpnServicePluginStateChangedSignalInfo
instance SignalInfo VpnServicePluginStateChangedSignalInfo where
    type HaskellCallbackType VpnServicePluginStateChangedSignalInfo = VpnServicePluginStateChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_VpnServicePluginStateChangedCallback cb
        cb'' <- mk_VpnServicePluginStateChangedCallback cb'
        connectSignalFunPtr obj "state-changed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.VpnServicePlugin::state-changed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-VpnServicePlugin.html#g:signal:stateChanged"})

#endif

-- VVV Prop "service-name"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@service-name@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' vpnServicePlugin #serviceName
-- @
getVpnServicePluginServiceName :: (MonadIO m, IsVpnServicePlugin o) => o -> m (Maybe T.Text)
getVpnServicePluginServiceName :: forall (m :: * -> *) o.
(MonadIO m, IsVpnServicePlugin o) =>
o -> m (Maybe Text)
getVpnServicePluginServiceName o
obj = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe 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
"service-name"

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

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

-- VVV Prop "state"
   -- Type: TInterface (Name {namespace = "NM", name = "VpnServiceState"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@state@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' vpnServicePlugin #state
-- @
getVpnServicePluginState :: (MonadIO m, IsVpnServicePlugin o) => o -> m NM.Enums.VpnServiceState
getVpnServicePluginState :: forall (m :: * -> *) o.
(MonadIO m, IsVpnServicePlugin o) =>
o -> m VpnServiceState
getVpnServicePluginState o
obj = IO VpnServiceState -> m VpnServiceState
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO VpnServiceState -> m VpnServiceState)
-> IO VpnServiceState -> m VpnServiceState
forall a b. (a -> b) -> a -> b
$ o -> String -> IO VpnServiceState
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"state"

-- | Set the value of the “@state@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' vpnServicePlugin [ #state 'Data.GI.Base.Attributes.:=' value ]
-- @
setVpnServicePluginState :: (MonadIO m, IsVpnServicePlugin o) => o -> NM.Enums.VpnServiceState -> m ()
setVpnServicePluginState :: forall (m :: * -> *) o.
(MonadIO m, IsVpnServicePlugin o) =>
o -> VpnServiceState -> m ()
setVpnServicePluginState o
obj VpnServiceState
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> VpnServiceState -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj String
"state" VpnServiceState
val

-- | Construct a t'GValueConstruct' with valid value for the “@state@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructVpnServicePluginState :: (IsVpnServicePlugin o, MIO.MonadIO m) => NM.Enums.VpnServiceState -> m (GValueConstruct o)
constructVpnServicePluginState :: forall o (m :: * -> *).
(IsVpnServicePlugin o, MonadIO m) =>
VpnServiceState -> m (GValueConstruct o)
constructVpnServicePluginState VpnServiceState
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 -> VpnServiceState -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"state" VpnServiceState
val

#if defined(ENABLE_OVERLOADING)
data VpnServicePluginStatePropertyInfo
instance AttrInfo VpnServicePluginStatePropertyInfo where
    type AttrAllowedOps VpnServicePluginStatePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint VpnServicePluginStatePropertyInfo = IsVpnServicePlugin
    type AttrSetTypeConstraint VpnServicePluginStatePropertyInfo = (~) NM.Enums.VpnServiceState
    type AttrTransferTypeConstraint VpnServicePluginStatePropertyInfo = (~) NM.Enums.VpnServiceState
    type AttrTransferType VpnServicePluginStatePropertyInfo = NM.Enums.VpnServiceState
    type AttrGetType VpnServicePluginStatePropertyInfo = NM.Enums.VpnServiceState
    type AttrLabel VpnServicePluginStatePropertyInfo = "state"
    type AttrOrigin VpnServicePluginStatePropertyInfo = VpnServicePlugin
    attrGet = getVpnServicePluginState
    attrSet = setVpnServicePluginState
    attrTransfer _ v = do
        return v
    attrConstruct = constructVpnServicePluginState
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.VpnServicePlugin.state"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-VpnServicePlugin.html#g:attr:state"
        })
#endif

-- VVV Prop "watch-peer"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@watch-peer@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' vpnServicePlugin #watchPeer
-- @
getVpnServicePluginWatchPeer :: (MonadIO m, IsVpnServicePlugin o) => o -> m Bool
getVpnServicePluginWatchPeer :: forall (m :: * -> *) o.
(MonadIO m, IsVpnServicePlugin o) =>
o -> m Bool
getVpnServicePluginWatchPeer o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"watch-peer"

-- | Construct a t'GValueConstruct' with valid value for the “@watch-peer@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructVpnServicePluginWatchPeer :: (IsVpnServicePlugin o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructVpnServicePluginWatchPeer :: forall o (m :: * -> *).
(IsVpnServicePlugin o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructVpnServicePluginWatchPeer Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"watch-peer" Bool
val

#if defined(ENABLE_OVERLOADING)
data VpnServicePluginWatchPeerPropertyInfo
instance AttrInfo VpnServicePluginWatchPeerPropertyInfo where
    type AttrAllowedOps VpnServicePluginWatchPeerPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint VpnServicePluginWatchPeerPropertyInfo = IsVpnServicePlugin
    type AttrSetTypeConstraint VpnServicePluginWatchPeerPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint VpnServicePluginWatchPeerPropertyInfo = (~) Bool
    type AttrTransferType VpnServicePluginWatchPeerPropertyInfo = Bool
    type AttrGetType VpnServicePluginWatchPeerPropertyInfo = Bool
    type AttrLabel VpnServicePluginWatchPeerPropertyInfo = "watch-peer"
    type AttrOrigin VpnServicePluginWatchPeerPropertyInfo = VpnServicePlugin
    attrGet = getVpnServicePluginWatchPeer
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructVpnServicePluginWatchPeer
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Objects.VpnServicePlugin.watchPeer"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Objects-VpnServicePlugin.html#g:attr:watchPeer"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList VpnServicePlugin
type instance O.AttributeList VpnServicePlugin = VpnServicePluginAttributeList
type VpnServicePluginAttributeList = ('[ '("serviceName", VpnServicePluginServiceNamePropertyInfo), '("state", VpnServicePluginStatePropertyInfo), '("watchPeer", VpnServicePluginWatchPeerPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
vpnServicePluginServiceName :: AttrLabelProxy "serviceName"
vpnServicePluginServiceName = AttrLabelProxy

vpnServicePluginState :: AttrLabelProxy "state"
vpnServicePluginState = AttrLabelProxy

vpnServicePluginWatchPeer :: AttrLabelProxy "watchPeer"
vpnServicePluginWatchPeer = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList VpnServicePlugin = VpnServicePluginSignalList
type VpnServicePluginSignalList = ('[ '("config", VpnServicePluginConfigSignalInfo), '("failure", VpnServicePluginFailureSignalInfo), '("ip4Config", VpnServicePluginIp4ConfigSignalInfo), '("ip6Config", VpnServicePluginIp6ConfigSignalInfo), '("loginBanner", VpnServicePluginLoginBannerSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("quit", VpnServicePluginQuitSignalInfo), '("secretsRequired", VpnServicePluginSecretsRequiredSignalInfo), '("stateChanged", VpnServicePluginStateChangedSignalInfo)] :: [(Symbol, DK.Type)])

#endif

-- method VpnServicePlugin::disconnect
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "plugin"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "VpnServicePlugin" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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_service_plugin_disconnect" nm_vpn_service_plugin_disconnect :: 
    Ptr VpnServicePlugin ->                 -- plugin : TInterface (Name {namespace = "NM", name = "VpnServicePlugin"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | /No description available in the introspection data./
-- 
-- /Since: 1.2/
vpnServicePluginDisconnect ::
    (B.CallStack.HasCallStack, MonadIO m, IsVpnServicePlugin a) =>
    a
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
vpnServicePluginDisconnect :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVpnServicePlugin a) =>
a -> m ()
vpnServicePluginDisconnect a
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 VpnServicePlugin
plugin' <- a -> IO (Ptr VpnServicePlugin)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
plugin
    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 VpnServicePlugin -> Ptr (Ptr GError) -> IO CInt
nm_vpn_service_plugin_disconnect Ptr VpnServicePlugin
plugin'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
plugin
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data VpnServicePluginDisconnectMethodInfo
instance (signature ~ (m ()), MonadIO m, IsVpnServicePlugin a) => O.OverloadedMethod VpnServicePluginDisconnectMethodInfo a signature where
    overloadedMethod = vpnServicePluginDisconnect

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


#endif

-- method VpnServicePlugin::failure
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "plugin"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "VpnServicePlugin" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "reason"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "VpnPluginFailure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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_service_plugin_failure" nm_vpn_service_plugin_failure :: 
    Ptr VpnServicePlugin ->                 -- plugin : TInterface (Name {namespace = "NM", name = "VpnServicePlugin"})
    CUInt ->                                -- reason : TInterface (Name {namespace = "NM", name = "VpnPluginFailure"})
    IO ()

-- | /No description available in the introspection data./
-- 
-- /Since: 1.2/
vpnServicePluginFailure ::
    (B.CallStack.HasCallStack, MonadIO m, IsVpnServicePlugin a) =>
    a
    -> NM.Enums.VpnPluginFailure
    -> m ()
vpnServicePluginFailure :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVpnServicePlugin a) =>
a -> VpnPluginFailure -> m ()
vpnServicePluginFailure a
plugin VpnPluginFailure
reason = 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 VpnServicePlugin
plugin' <- a -> IO (Ptr VpnServicePlugin)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
plugin
    let reason' :: CUInt
reason' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (VpnPluginFailure -> Int) -> VpnPluginFailure -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VpnPluginFailure -> Int
forall a. Enum a => a -> Int
fromEnum) VpnPluginFailure
reason
    Ptr VpnServicePlugin -> CUInt -> IO ()
nm_vpn_service_plugin_failure Ptr VpnServicePlugin
plugin' CUInt
reason'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
plugin
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data VpnServicePluginFailureMethodInfo
instance (signature ~ (NM.Enums.VpnPluginFailure -> m ()), MonadIO m, IsVpnServicePlugin a) => O.OverloadedMethod VpnServicePluginFailureMethodInfo a signature where
    overloadedMethod = vpnServicePluginFailure

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


#endif

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

foreign import ccall "nm_vpn_service_plugin_get_connection" nm_vpn_service_plugin_get_connection :: 
    Ptr VpnServicePlugin ->                 -- plugin : TInterface (Name {namespace = "NM", name = "VpnServicePlugin"})
    IO (Ptr Gio.DBusConnection.DBusConnection)

-- | /No description available in the introspection data./
-- 
-- /Since: 1.2/
vpnServicePluginGetConnection ::
    (B.CallStack.HasCallStack, MonadIO m, IsVpnServicePlugin a) =>
    a
    -> m Gio.DBusConnection.DBusConnection
vpnServicePluginGetConnection :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVpnServicePlugin a) =>
a -> m DBusConnection
vpnServicePluginGetConnection a
plugin = IO DBusConnection -> m DBusConnection
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DBusConnection -> m DBusConnection)
-> IO DBusConnection -> m DBusConnection
forall a b. (a -> b) -> a -> b
$ do
    Ptr VpnServicePlugin
plugin' <- a -> IO (Ptr VpnServicePlugin)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
plugin
    Ptr DBusConnection
result <- Ptr VpnServicePlugin -> IO (Ptr DBusConnection)
nm_vpn_service_plugin_get_connection Ptr VpnServicePlugin
plugin'
    Text -> Ptr DBusConnection -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"vpnServicePluginGetConnection" Ptr DBusConnection
result
    DBusConnection
result' <- ((ManagedPtr DBusConnection -> DBusConnection)
-> Ptr DBusConnection -> IO DBusConnection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr DBusConnection -> DBusConnection
Gio.DBusConnection.DBusConnection) Ptr DBusConnection
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
plugin
    DBusConnection -> IO DBusConnection
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return DBusConnection
result'

#if defined(ENABLE_OVERLOADING)
data VpnServicePluginGetConnectionMethodInfo
instance (signature ~ (m Gio.DBusConnection.DBusConnection), MonadIO m, IsVpnServicePlugin a) => O.OverloadedMethod VpnServicePluginGetConnectionMethodInfo a signature where
    overloadedMethod = vpnServicePluginGetConnection

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


#endif

-- method VpnServicePlugin::secrets_required
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "plugin"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "VpnServicePlugin" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMVpnServicePlugin"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "message"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "an information message about why secrets are required, if any"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "hints"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "VPN specific secret names for required new secrets"
--                 , 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_service_plugin_secrets_required" nm_vpn_service_plugin_secrets_required :: 
    Ptr VpnServicePlugin ->                 -- plugin : TInterface (Name {namespace = "NM", name = "VpnServicePlugin"})
    CString ->                              -- message : TBasicType TUTF8
    CString ->                              -- hints : TBasicType TUTF8
    IO ()

-- | Called by VPN plugin implementations to signal to NetworkManager that secrets
-- are required during the connection process.  This signal may be used to
-- request new secrets when the secrets originally provided by NetworkManager
-- are insufficient, or the VPN process indicates that it needs additional
-- information to complete the request.
-- 
-- /Since: 1.2/
vpnServicePluginSecretsRequired ::
    (B.CallStack.HasCallStack, MonadIO m, IsVpnServicePlugin a) =>
    a
    -- ^ /@plugin@/: the t'GI.NM.Objects.VpnServicePlugin.VpnServicePlugin'
    -> T.Text
    -- ^ /@message@/: an information message about why secrets are required, if any
    -> T.Text
    -- ^ /@hints@/: VPN specific secret names for required new secrets
    -> m ()
vpnServicePluginSecretsRequired :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVpnServicePlugin a) =>
a -> Text -> Text -> m ()
vpnServicePluginSecretsRequired a
plugin Text
message Text
hints = 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 VpnServicePlugin
plugin' <- a -> IO (Ptr VpnServicePlugin)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
plugin
    CString
message' <- Text -> IO CString
textToCString Text
message
    CString
hints' <- Text -> IO CString
textToCString Text
hints
    Ptr VpnServicePlugin -> CString -> CString -> IO ()
nm_vpn_service_plugin_secrets_required Ptr VpnServicePlugin
plugin' CString
message' CString
hints'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
plugin
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
message'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
hints'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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


#endif

-- method VpnServicePlugin::set_config
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "plugin"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "VpnServicePlugin" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "config"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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_service_plugin_set_config" nm_vpn_service_plugin_set_config :: 
    Ptr VpnServicePlugin ->                 -- plugin : TInterface (Name {namespace = "NM", name = "VpnServicePlugin"})
    Ptr GVariant ->                         -- config : TVariant
    IO ()

-- | /No description available in the introspection data./
-- 
-- /Since: 1.2/
vpnServicePluginSetConfig ::
    (B.CallStack.HasCallStack, MonadIO m, IsVpnServicePlugin a) =>
    a
    -> GVariant
    -> m ()
vpnServicePluginSetConfig :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVpnServicePlugin a) =>
a -> GVariant -> m ()
vpnServicePluginSetConfig a
plugin GVariant
config = 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 VpnServicePlugin
plugin' <- a -> IO (Ptr VpnServicePlugin)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
plugin
    Ptr GVariant
config' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
config
    Ptr VpnServicePlugin -> Ptr GVariant -> IO ()
nm_vpn_service_plugin_set_config Ptr VpnServicePlugin
plugin' Ptr GVariant
config'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
plugin
    VpnServicePluginConfigCallback
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GVariant
config
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data VpnServicePluginSetConfigMethodInfo
instance (signature ~ (GVariant -> m ()), MonadIO m, IsVpnServicePlugin a) => O.OverloadedMethod VpnServicePluginSetConfigMethodInfo a signature where
    overloadedMethod = vpnServicePluginSetConfig

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


#endif

-- method VpnServicePlugin::set_ip4_config
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "plugin"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "VpnServicePlugin" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ip4_config"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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_service_plugin_set_ip4_config" nm_vpn_service_plugin_set_ip4_config :: 
    Ptr VpnServicePlugin ->                 -- plugin : TInterface (Name {namespace = "NM", name = "VpnServicePlugin"})
    Ptr GVariant ->                         -- ip4_config : TVariant
    IO ()

-- | /No description available in the introspection data./
-- 
-- /Since: 1.2/
vpnServicePluginSetIp4Config ::
    (B.CallStack.HasCallStack, MonadIO m, IsVpnServicePlugin a) =>
    a
    -> GVariant
    -> m ()
vpnServicePluginSetIp4Config :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVpnServicePlugin a) =>
a -> GVariant -> m ()
vpnServicePluginSetIp4Config a
plugin GVariant
ip4Config = 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 VpnServicePlugin
plugin' <- a -> IO (Ptr VpnServicePlugin)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
plugin
    Ptr GVariant
ip4Config' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
ip4Config
    Ptr VpnServicePlugin -> Ptr GVariant -> IO ()
nm_vpn_service_plugin_set_ip4_config Ptr VpnServicePlugin
plugin' Ptr GVariant
ip4Config'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
plugin
    VpnServicePluginConfigCallback
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GVariant
ip4Config
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data VpnServicePluginSetIp4ConfigMethodInfo
instance (signature ~ (GVariant -> m ()), MonadIO m, IsVpnServicePlugin a) => O.OverloadedMethod VpnServicePluginSetIp4ConfigMethodInfo a signature where
    overloadedMethod = vpnServicePluginSetIp4Config

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


#endif

-- method VpnServicePlugin::set_ip6_config
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "plugin"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "VpnServicePlugin" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ip6_config"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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_service_plugin_set_ip6_config" nm_vpn_service_plugin_set_ip6_config :: 
    Ptr VpnServicePlugin ->                 -- plugin : TInterface (Name {namespace = "NM", name = "VpnServicePlugin"})
    Ptr GVariant ->                         -- ip6_config : TVariant
    IO ()

-- | /No description available in the introspection data./
-- 
-- /Since: 1.2/
vpnServicePluginSetIp6Config ::
    (B.CallStack.HasCallStack, MonadIO m, IsVpnServicePlugin a) =>
    a
    -> GVariant
    -> m ()
vpnServicePluginSetIp6Config :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVpnServicePlugin a) =>
a -> GVariant -> m ()
vpnServicePluginSetIp6Config a
plugin GVariant
ip6Config = 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 VpnServicePlugin
plugin' <- a -> IO (Ptr VpnServicePlugin)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
plugin
    Ptr GVariant
ip6Config' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
ip6Config
    Ptr VpnServicePlugin -> Ptr GVariant -> IO ()
nm_vpn_service_plugin_set_ip6_config Ptr VpnServicePlugin
plugin' Ptr GVariant
ip6Config'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
plugin
    VpnServicePluginConfigCallback
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GVariant
ip6Config
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data VpnServicePluginSetIp6ConfigMethodInfo
instance (signature ~ (GVariant -> m ()), MonadIO m, IsVpnServicePlugin a) => O.OverloadedMethod VpnServicePluginSetIp6ConfigMethodInfo a signature where
    overloadedMethod = vpnServicePluginSetIp6Config

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


#endif

-- method VpnServicePlugin::set_login_banner
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "plugin"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "VpnServicePlugin" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "banner"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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_service_plugin_set_login_banner" nm_vpn_service_plugin_set_login_banner :: 
    Ptr VpnServicePlugin ->                 -- plugin : TInterface (Name {namespace = "NM", name = "VpnServicePlugin"})
    CString ->                              -- banner : TBasicType TUTF8
    IO ()

-- | /No description available in the introspection data./
-- 
-- /Since: 1.2/
vpnServicePluginSetLoginBanner ::
    (B.CallStack.HasCallStack, MonadIO m, IsVpnServicePlugin a) =>
    a
    -> T.Text
    -> m ()
vpnServicePluginSetLoginBanner :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVpnServicePlugin a) =>
a -> Text -> m ()
vpnServicePluginSetLoginBanner a
plugin Text
banner = 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 VpnServicePlugin
plugin' <- a -> IO (Ptr VpnServicePlugin)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
plugin
    CString
banner' <- Text -> IO CString
textToCString Text
banner
    Ptr VpnServicePlugin -> CString -> IO ()
nm_vpn_service_plugin_set_login_banner Ptr VpnServicePlugin
plugin' CString
banner'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
plugin
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
banner'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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


#endif

-- method VpnServicePlugin::shutdown
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "plugin"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "VpnServicePlugin" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMVpnServicePlugin 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_service_plugin_shutdown" nm_vpn_service_plugin_shutdown :: 
    Ptr VpnServicePlugin ->                 -- plugin : TInterface (Name {namespace = "NM", name = "VpnServicePlugin"})
    IO ()

-- | Shutdown the /@plugin@/ and disconnect from D-Bus. After this,
-- the plugin instance is dead and should no longer be used.
-- It ensures to get no more requests from D-Bus. In principle,
-- you don\'t need to shutdown the plugin, disposing the instance
-- has the same effect. However, this gives a way to deactivate
-- the plugin before giving up the last reference.
-- 
-- /Since: 1.12/
vpnServicePluginShutdown ::
    (B.CallStack.HasCallStack, MonadIO m, IsVpnServicePlugin a) =>
    a
    -- ^ /@plugin@/: the t'GI.NM.Objects.VpnServicePlugin.VpnServicePlugin' instance
    -> m ()
vpnServicePluginShutdown :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVpnServicePlugin a) =>
a -> m ()
vpnServicePluginShutdown a
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 VpnServicePlugin
plugin' <- a -> IO (Ptr VpnServicePlugin)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
plugin
    Ptr VpnServicePlugin -> IO ()
nm_vpn_service_plugin_shutdown Ptr VpnServicePlugin
plugin'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
plugin
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data VpnServicePluginShutdownMethodInfo
instance (signature ~ (m ()), MonadIO m, IsVpnServicePlugin a) => O.OverloadedMethod VpnServicePluginShutdownMethodInfo a signature where
    overloadedMethod = vpnServicePluginShutdown

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


#endif

-- method VpnServicePlugin::get_secret_flags
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "data"
--           , argType = TGHash (TBasicType TPtr) (TBasicType TPtr)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "hash table containing VPN key/value pair data items"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "secret_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "VPN secret key name for which to retrieve flags for"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_flags"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "SettingSecretFlags" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "on success, the flags associated with @secret_name"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "nm_vpn_service_plugin_get_secret_flags" nm_vpn_service_plugin_get_secret_flags :: 
    Ptr (GHashTable (Ptr ()) (Ptr ())) ->   -- data : TGHash (TBasicType TPtr) (TBasicType TPtr)
    CString ->                              -- secret_name : TBasicType TUTF8
    Ptr CUInt ->                            -- out_flags : TInterface (Name {namespace = "NM", name = "SettingSecretFlags"})
    IO CInt

-- | Given a VPN secret key name, attempts to find the corresponding flags data
-- item in /@data@/.  If found, converts the flags data item to
-- t'GI.NM.Flags.SettingSecretFlags' and returns it.
-- 
-- /Since: 1.2/
vpnServicePluginGetSecretFlags ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Map.Map (Ptr ()) (Ptr ())
    -- ^ /@data@/: hash table containing VPN key\/value pair data items
    -> T.Text
    -- ^ /@secretName@/: VPN secret key name for which to retrieve flags for
    -> m ((Bool, [NM.Flags.SettingSecretFlags]))
    -- ^ __Returns:__ 'P.True' if the flag data item was found and successfully converted
    -- to flags, 'P.False' if not
vpnServicePluginGetSecretFlags :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Map (Ptr ()) (Ptr ()) -> Text -> m (Bool, [SettingSecretFlags])
vpnServicePluginGetSecretFlags Map (Ptr ()) (Ptr ())
data_ Text
secretName = IO (Bool, [SettingSecretFlags]) -> m (Bool, [SettingSecretFlags])
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, [SettingSecretFlags]) -> m (Bool, [SettingSecretFlags]))
-> IO (Bool, [SettingSecretFlags])
-> m (Bool, [SettingSecretFlags])
forall a b. (a -> b) -> a -> b
$ do
    let data_' :: [(Ptr (), Ptr ())]
data_' = Map (Ptr ()) (Ptr ()) -> [(Ptr (), Ptr ())]
forall k a. Map k a -> [(k, a)]
Map.toList Map (Ptr ()) (Ptr ())
data_
    let data_'' :: [(PtrWrapped (Ptr ()), Ptr ())]
data_'' = (Ptr () -> PtrWrapped (Ptr ()))
-> [(Ptr (), Ptr ())] -> [(PtrWrapped (Ptr ()), Ptr ())]
forall a c b. (a -> c) -> [(a, b)] -> [(c, b)]
mapFirst Ptr () -> PtrWrapped (Ptr ())
forall a. Ptr a -> PtrWrapped (Ptr a)
B.GHT.ptrPackPtr [(Ptr (), Ptr ())]
data_'
    let data_''' :: [(PtrWrapped (Ptr ()), PtrWrapped (Ptr ()))]
data_''' = (Ptr () -> PtrWrapped (Ptr ()))
-> [(PtrWrapped (Ptr ()), Ptr ())]
-> [(PtrWrapped (Ptr ()), PtrWrapped (Ptr ()))]
forall b c a. (b -> c) -> [(a, b)] -> [(a, c)]
mapSecond Ptr () -> PtrWrapped (Ptr ())
forall a. Ptr a -> PtrWrapped (Ptr a)
B.GHT.ptrPackPtr [(PtrWrapped (Ptr ()), Ptr ())]
data_''
    Ptr (GHashTable (Ptr ()) (Ptr ()))
data_'''' <- GHashFunc (Ptr ())
-> GEqualFunc (Ptr ())
-> Maybe (GDestroyNotify (Ptr ()))
-> Maybe (GDestroyNotify (Ptr ()))
-> [(PtrWrapped (Ptr ()), PtrWrapped (Ptr ()))]
-> IO (Ptr (GHashTable (Ptr ()) (Ptr ())))
forall a b.
GHashFunc a
-> GEqualFunc a
-> Maybe (GDestroyNotify a)
-> Maybe (GDestroyNotify b)
-> [(PtrWrapped a, PtrWrapped b)]
-> IO (Ptr (GHashTable a b))
packGHashTable GHashFunc (Ptr ())
forall a. GHashFunc (Ptr a)
gDirectHash GEqualFunc (Ptr ())
forall a. GEqualFunc (Ptr a)
gDirectEqual Maybe (GDestroyNotify (Ptr ()))
forall a. Maybe a
Nothing Maybe (GDestroyNotify (Ptr ()))
forall a. Maybe a
Nothing [(PtrWrapped (Ptr ()), PtrWrapped (Ptr ()))]
data_'''
    CString
secretName' <- Text -> IO CString
textToCString Text
secretName
    Ptr CUInt
outFlags <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    CInt
result <- Ptr (GHashTable (Ptr ()) (Ptr ()))
-> CString -> Ptr CUInt -> IO CInt
nm_vpn_service_plugin_get_secret_flags Ptr (GHashTable (Ptr ()) (Ptr ()))
data_'''' CString
secretName' Ptr CUInt
outFlags
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CUInt
outFlags' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
outFlags
    let outFlags'' :: [SettingSecretFlags]
outFlags'' = CUInt -> [SettingSecretFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
outFlags'
    Ptr (GHashTable (Ptr ()) (Ptr ())) -> IO ()
forall a b. Ptr (GHashTable a b) -> IO ()
unrefGHashTable Ptr (GHashTable (Ptr ()) (Ptr ()))
data_''''
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
secretName'
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
outFlags
    (Bool, [SettingSecretFlags]) -> IO (Bool, [SettingSecretFlags])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', [SettingSecretFlags]
outFlags'')

#if defined(ENABLE_OVERLOADING)
#endif

-- method VpnServicePlugin::read_vpn_details
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "fd"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "file descriptor to read from, usually stdin (0)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_data"
--           , argType = TGHash (TBasicType TPtr) (TBasicType TPtr)
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "on successful return, a hash table\n(mapping char*:char*) containing the key/value pairs of VPN data items"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "out_secrets"
--           , argType = TGHash (TBasicType TPtr) (TBasicType TPtr)
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "on successful return, a hash table\n(mapping char*:char*) containing the key/value pairsof VPN secrets"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "nm_vpn_service_plugin_read_vpn_details" nm_vpn_service_plugin_read_vpn_details :: 
    Int32 ->                                -- fd : TBasicType TInt
    Ptr (Ptr (GHashTable (Ptr ()) (Ptr ()))) -> -- out_data : TGHash (TBasicType TPtr) (TBasicType TPtr)
    Ptr (Ptr (GHashTable (Ptr ()) (Ptr ()))) -> -- out_secrets : TGHash (TBasicType TPtr) (TBasicType TPtr)
    IO CInt

-- | Parses key\/value pairs from a file descriptor (normally stdin) passed by
-- an applet when the applet calls the authentication dialog of the VPN plugin.
-- 
-- /Since: 1.2/
vpnServicePluginReadVpnDetails ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Int32
    -- ^ /@fd@/: file descriptor to read from, usually stdin (0)
    -> m ((Bool, Map.Map (Ptr ()) (Ptr ()), Map.Map (Ptr ()) (Ptr ())))
    -- ^ __Returns:__ 'P.True' if reading values was successful, 'P.False' if not
vpnServicePluginReadVpnDetails :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Int32 -> m (Bool, Map (Ptr ()) (Ptr ()), Map (Ptr ()) (Ptr ()))
vpnServicePluginReadVpnDetails Int32
fd = IO (Bool, Map (Ptr ()) (Ptr ()), Map (Ptr ()) (Ptr ()))
-> m (Bool, Map (Ptr ()) (Ptr ()), Map (Ptr ()) (Ptr ()))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Map (Ptr ()) (Ptr ()), Map (Ptr ()) (Ptr ()))
 -> m (Bool, Map (Ptr ()) (Ptr ()), Map (Ptr ()) (Ptr ())))
-> IO (Bool, Map (Ptr ()) (Ptr ()), Map (Ptr ()) (Ptr ()))
-> m (Bool, Map (Ptr ()) (Ptr ()), Map (Ptr ()) (Ptr ()))
forall a b. (a -> b) -> a -> b
$ do
    Ptr (Ptr (GHashTable (Ptr ()) (Ptr ())))
outData <- IO (Ptr (Ptr (GHashTable (Ptr ()) (Ptr ()))))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr (GHashTable (Ptr ()) (Ptr ()))))
    Ptr (Ptr (GHashTable (Ptr ()) (Ptr ())))
outSecrets <- IO (Ptr (Ptr (GHashTable (Ptr ()) (Ptr ()))))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr (GHashTable (Ptr ()) (Ptr ()))))
    CInt
result <- Int32
-> Ptr (Ptr (GHashTable (Ptr ()) (Ptr ())))
-> Ptr (Ptr (GHashTable (Ptr ()) (Ptr ())))
-> IO CInt
nm_vpn_service_plugin_read_vpn_details Int32
fd Ptr (Ptr (GHashTable (Ptr ()) (Ptr ())))
outData Ptr (Ptr (GHashTable (Ptr ()) (Ptr ())))
outSecrets
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Ptr (GHashTable (Ptr ()) (Ptr ()))
outData' <- Ptr (Ptr (GHashTable (Ptr ()) (Ptr ())))
-> IO (Ptr (GHashTable (Ptr ()) (Ptr ())))
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr (GHashTable (Ptr ()) (Ptr ())))
outData
    [(PtrWrapped (Ptr ()), PtrWrapped (Ptr ()))]
outData'' <- Ptr (GHashTable (Ptr ()) (Ptr ()))
-> IO [(PtrWrapped (Ptr ()), PtrWrapped (Ptr ()))]
forall a b.
Ptr (GHashTable a b) -> IO [(PtrWrapped a, PtrWrapped b)]
unpackGHashTable Ptr (GHashTable (Ptr ()) (Ptr ()))
outData'
    let outData''' :: [(Ptr (), PtrWrapped (Ptr ()))]
outData''' = (PtrWrapped (Ptr ()) -> Ptr ())
-> [(PtrWrapped (Ptr ()), PtrWrapped (Ptr ()))]
-> [(Ptr (), PtrWrapped (Ptr ()))]
forall a c b. (a -> c) -> [(a, b)] -> [(c, b)]
mapFirst PtrWrapped (Ptr ()) -> Ptr ()
forall a. PtrWrapped (Ptr a) -> Ptr a
B.GHT.ptrUnpackPtr [(PtrWrapped (Ptr ()), PtrWrapped (Ptr ()))]
outData''
    let outData'''' :: [(Ptr (), Ptr ())]
outData'''' = (PtrWrapped (Ptr ()) -> Ptr ())
-> [(Ptr (), PtrWrapped (Ptr ()))] -> [(Ptr (), Ptr ())]
forall b c a. (b -> c) -> [(a, b)] -> [(a, c)]
mapSecond PtrWrapped (Ptr ()) -> Ptr ()
forall a. PtrWrapped (Ptr a) -> Ptr a
B.GHT.ptrUnpackPtr [(Ptr (), PtrWrapped (Ptr ()))]
outData'''
    let outData''''' :: Map (Ptr ()) (Ptr ())
outData''''' = [(Ptr (), Ptr ())] -> Map (Ptr ()) (Ptr ())
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Ptr (), Ptr ())]
outData''''
    Ptr (GHashTable (Ptr ()) (Ptr ())) -> IO ()
forall a b. Ptr (GHashTable a b) -> IO ()
unrefGHashTable Ptr (GHashTable (Ptr ()) (Ptr ()))
outData'
    Ptr (GHashTable (Ptr ()) (Ptr ()))
outSecrets' <- Ptr (Ptr (GHashTable (Ptr ()) (Ptr ())))
-> IO (Ptr (GHashTable (Ptr ()) (Ptr ())))
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr (GHashTable (Ptr ()) (Ptr ())))
outSecrets
    [(PtrWrapped (Ptr ()), PtrWrapped (Ptr ()))]
outSecrets'' <- Ptr (GHashTable (Ptr ()) (Ptr ()))
-> IO [(PtrWrapped (Ptr ()), PtrWrapped (Ptr ()))]
forall a b.
Ptr (GHashTable a b) -> IO [(PtrWrapped a, PtrWrapped b)]
unpackGHashTable Ptr (GHashTable (Ptr ()) (Ptr ()))
outSecrets'
    let outSecrets''' :: [(Ptr (), PtrWrapped (Ptr ()))]
outSecrets''' = (PtrWrapped (Ptr ()) -> Ptr ())
-> [(PtrWrapped (Ptr ()), PtrWrapped (Ptr ()))]
-> [(Ptr (), PtrWrapped (Ptr ()))]
forall a c b. (a -> c) -> [(a, b)] -> [(c, b)]
mapFirst PtrWrapped (Ptr ()) -> Ptr ()
forall a. PtrWrapped (Ptr a) -> Ptr a
B.GHT.ptrUnpackPtr [(PtrWrapped (Ptr ()), PtrWrapped (Ptr ()))]
outSecrets''
    let outSecrets'''' :: [(Ptr (), Ptr ())]
outSecrets'''' = (PtrWrapped (Ptr ()) -> Ptr ())
-> [(Ptr (), PtrWrapped (Ptr ()))] -> [(Ptr (), Ptr ())]
forall b c a. (b -> c) -> [(a, b)] -> [(a, c)]
mapSecond PtrWrapped (Ptr ()) -> Ptr ()
forall a. PtrWrapped (Ptr a) -> Ptr a
B.GHT.ptrUnpackPtr [(Ptr (), PtrWrapped (Ptr ()))]
outSecrets'''
    let outSecrets''''' :: Map (Ptr ()) (Ptr ())
outSecrets''''' = [(Ptr (), Ptr ())] -> Map (Ptr ()) (Ptr ())
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Ptr (), Ptr ())]
outSecrets''''
    Ptr (GHashTable (Ptr ()) (Ptr ())) -> IO ()
forall a b. Ptr (GHashTable a b) -> IO ()
unrefGHashTable Ptr (GHashTable (Ptr ()) (Ptr ()))
outSecrets'
    Ptr (Ptr (GHashTable (Ptr ()) (Ptr ()))) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr (GHashTable (Ptr ()) (Ptr ())))
outData
    Ptr (Ptr (GHashTable (Ptr ()) (Ptr ()))) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr (GHashTable (Ptr ()) (Ptr ())))
outSecrets
    (Bool, Map (Ptr ()) (Ptr ()), Map (Ptr ()) (Ptr ()))
-> IO (Bool, Map (Ptr ()) (Ptr ()), Map (Ptr ()) (Ptr ()))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Map (Ptr ()) (Ptr ())
outData''''', Map (Ptr ()) (Ptr ())
outSecrets''''')

#if defined(ENABLE_OVERLOADING)
#endif