{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The settings of one WireGuard peer.
-- 
-- /Since: 1.16/

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

module GI.NM.Structs.WireGuardPeer
    ( 

-- * Exported types
    WireGuardPeer(..)                       ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [appendAllowedIp]("GI.NM.Structs.WireGuardPeer#g:method:appendAllowedIp"), [clearAllowedIps]("GI.NM.Structs.WireGuardPeer#g:method:clearAllowedIps"), [cmp]("GI.NM.Structs.WireGuardPeer#g:method:cmp"), [isSealed]("GI.NM.Structs.WireGuardPeer#g:method:isSealed"), [isValid]("GI.NM.Structs.WireGuardPeer#g:method:isValid"), [newClone]("GI.NM.Structs.WireGuardPeer#g:method:newClone"), [ref]("GI.NM.Structs.WireGuardPeer#g:method:ref"), [removeAllowedIp]("GI.NM.Structs.WireGuardPeer#g:method:removeAllowedIp"), [seal]("GI.NM.Structs.WireGuardPeer#g:method:seal"), [unref]("GI.NM.Structs.WireGuardPeer#g:method:unref").
-- 
-- ==== Getters
-- [getAllowedIp]("GI.NM.Structs.WireGuardPeer#g:method:getAllowedIp"), [getAllowedIpsLen]("GI.NM.Structs.WireGuardPeer#g:method:getAllowedIpsLen"), [getEndpoint]("GI.NM.Structs.WireGuardPeer#g:method:getEndpoint"), [getPersistentKeepalive]("GI.NM.Structs.WireGuardPeer#g:method:getPersistentKeepalive"), [getPresharedKey]("GI.NM.Structs.WireGuardPeer#g:method:getPresharedKey"), [getPresharedKeyFlags]("GI.NM.Structs.WireGuardPeer#g:method:getPresharedKeyFlags"), [getPublicKey]("GI.NM.Structs.WireGuardPeer#g:method:getPublicKey").
-- 
-- ==== Setters
-- [setEndpoint]("GI.NM.Structs.WireGuardPeer#g:method:setEndpoint"), [setPersistentKeepalive]("GI.NM.Structs.WireGuardPeer#g:method:setPersistentKeepalive"), [setPresharedKey]("GI.NM.Structs.WireGuardPeer#g:method:setPresharedKey"), [setPresharedKeyFlags]("GI.NM.Structs.WireGuardPeer#g:method:setPresharedKeyFlags"), [setPublicKey]("GI.NM.Structs.WireGuardPeer#g:method:setPublicKey").

#if defined(ENABLE_OVERLOADING)
    ResolveWireGuardPeerMethod              ,
#endif

-- ** appendAllowedIp #method:appendAllowedIp#

#if defined(ENABLE_OVERLOADING)
    WireGuardPeerAppendAllowedIpMethodInfo  ,
#endif
    wireGuardPeerAppendAllowedIp            ,


-- ** clearAllowedIps #method:clearAllowedIps#

#if defined(ENABLE_OVERLOADING)
    WireGuardPeerClearAllowedIpsMethodInfo  ,
#endif
    wireGuardPeerClearAllowedIps            ,


-- ** cmp #method:cmp#

#if defined(ENABLE_OVERLOADING)
    WireGuardPeerCmpMethodInfo              ,
#endif
    wireGuardPeerCmp                        ,


-- ** getAllowedIp #method:getAllowedIp#

#if defined(ENABLE_OVERLOADING)
    WireGuardPeerGetAllowedIpMethodInfo     ,
#endif
    wireGuardPeerGetAllowedIp               ,


-- ** getAllowedIpsLen #method:getAllowedIpsLen#

#if defined(ENABLE_OVERLOADING)
    WireGuardPeerGetAllowedIpsLenMethodInfo ,
#endif
    wireGuardPeerGetAllowedIpsLen           ,


-- ** getEndpoint #method:getEndpoint#

#if defined(ENABLE_OVERLOADING)
    WireGuardPeerGetEndpointMethodInfo      ,
#endif
    wireGuardPeerGetEndpoint                ,


-- ** getPersistentKeepalive #method:getPersistentKeepalive#

#if defined(ENABLE_OVERLOADING)
    WireGuardPeerGetPersistentKeepaliveMethodInfo,
#endif
    wireGuardPeerGetPersistentKeepalive     ,


-- ** getPresharedKey #method:getPresharedKey#

#if defined(ENABLE_OVERLOADING)
    WireGuardPeerGetPresharedKeyMethodInfo  ,
#endif
    wireGuardPeerGetPresharedKey            ,


-- ** getPresharedKeyFlags #method:getPresharedKeyFlags#

#if defined(ENABLE_OVERLOADING)
    WireGuardPeerGetPresharedKeyFlagsMethodInfo,
#endif
    wireGuardPeerGetPresharedKeyFlags       ,


-- ** getPublicKey #method:getPublicKey#

#if defined(ENABLE_OVERLOADING)
    WireGuardPeerGetPublicKeyMethodInfo     ,
#endif
    wireGuardPeerGetPublicKey               ,


-- ** isSealed #method:isSealed#

#if defined(ENABLE_OVERLOADING)
    WireGuardPeerIsSealedMethodInfo         ,
#endif
    wireGuardPeerIsSealed                   ,


-- ** isValid #method:isValid#

#if defined(ENABLE_OVERLOADING)
    WireGuardPeerIsValidMethodInfo          ,
#endif
    wireGuardPeerIsValid                    ,


-- ** new #method:new#

    wireGuardPeerNew                        ,


-- ** newClone #method:newClone#

#if defined(ENABLE_OVERLOADING)
    WireGuardPeerNewCloneMethodInfo         ,
#endif
    wireGuardPeerNewClone                   ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    WireGuardPeerRefMethodInfo              ,
#endif
    wireGuardPeerRef                        ,


-- ** removeAllowedIp #method:removeAllowedIp#

#if defined(ENABLE_OVERLOADING)
    WireGuardPeerRemoveAllowedIpMethodInfo  ,
#endif
    wireGuardPeerRemoveAllowedIp            ,


-- ** seal #method:seal#

#if defined(ENABLE_OVERLOADING)
    WireGuardPeerSealMethodInfo             ,
#endif
    wireGuardPeerSeal                       ,


-- ** setEndpoint #method:setEndpoint#

#if defined(ENABLE_OVERLOADING)
    WireGuardPeerSetEndpointMethodInfo      ,
#endif
    wireGuardPeerSetEndpoint                ,


-- ** setPersistentKeepalive #method:setPersistentKeepalive#

#if defined(ENABLE_OVERLOADING)
    WireGuardPeerSetPersistentKeepaliveMethodInfo,
#endif
    wireGuardPeerSetPersistentKeepalive     ,


-- ** setPresharedKey #method:setPresharedKey#

#if defined(ENABLE_OVERLOADING)
    WireGuardPeerSetPresharedKeyMethodInfo  ,
#endif
    wireGuardPeerSetPresharedKey            ,


-- ** setPresharedKeyFlags #method:setPresharedKeyFlags#

#if defined(ENABLE_OVERLOADING)
    WireGuardPeerSetPresharedKeyFlagsMethodInfo,
#endif
    wireGuardPeerSetPresharedKeyFlags       ,


-- ** setPublicKey #method:setPublicKey#

#if defined(ENABLE_OVERLOADING)
    WireGuardPeerSetPublicKeyMethodInfo     ,
#endif
    wireGuardPeerSetPublicKey               ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    WireGuardPeerUnrefMethodInfo            ,
#endif
    wireGuardPeerUnref                      ,




    ) 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 {-# SOURCE #-} qualified GI.NM.Enums as NM.Enums
import {-# SOURCE #-} qualified GI.NM.Flags as NM.Flags

#else
import {-# SOURCE #-} qualified GI.NM.Enums as NM.Enums
import {-# SOURCE #-} qualified GI.NM.Flags as NM.Flags

#endif

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

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

foreign import ccall "nm_wireguard_peer_get_type" c_nm_wireguard_peer_get_type :: 
    IO GType

type instance O.ParentTypes WireGuardPeer = '[]
instance O.HasParentTypes WireGuardPeer

instance B.Types.TypedObject WireGuardPeer where
    glibType :: IO GType
glibType = IO GType
c_nm_wireguard_peer_get_type

instance B.Types.GBoxed WireGuardPeer

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


#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList WireGuardPeer
type instance O.AttributeList WireGuardPeer = WireGuardPeerAttributeList
type WireGuardPeerAttributeList = ('[ ] :: [(Symbol, DK.Type)])
#endif

-- method WireGuardPeer::new
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "NM" , name = "WireGuardPeer" })
-- throws : False
-- Skip return : False

foreign import ccall "nm_wireguard_peer_new" nm_wireguard_peer_new :: 
    IO (Ptr WireGuardPeer)

-- | /No description available in the introspection data./
-- 
-- /Since: 1.16/
wireGuardPeerNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m WireGuardPeer
    -- ^ __Returns:__ a new, default, unsealed t'GI.NM.Structs.WireGuardPeer.WireGuardPeer' instance.
wireGuardPeerNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m WireGuardPeer
wireGuardPeerNew  = IO WireGuardPeer -> m WireGuardPeer
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO WireGuardPeer -> m WireGuardPeer)
-> IO WireGuardPeer -> m WireGuardPeer
forall a b. (a -> b) -> a -> b
$ do
    Ptr WireGuardPeer
result <- IO (Ptr WireGuardPeer)
nm_wireguard_peer_new
    Text -> Ptr WireGuardPeer -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"wireGuardPeerNew" Ptr WireGuardPeer
result
    WireGuardPeer
result' <- ((ManagedPtr WireGuardPeer -> WireGuardPeer)
-> Ptr WireGuardPeer -> IO WireGuardPeer
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr WireGuardPeer -> WireGuardPeer
WireGuardPeer) Ptr WireGuardPeer
result
    WireGuardPeer -> IO WireGuardPeer
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return WireGuardPeer
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method WireGuardPeer::append_allowed_ip
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "WireGuardPeer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the unsealed #NMWireGuardPeer instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "allowed_ip"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the allowed-ip entry to set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "accept_invalid"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "if %TRUE, also invalid @allowed_ip value\n  will be appended. Otherwise, the function does nothing\n  in face of invalid values and returns %FALSE."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "nm_wireguard_peer_append_allowed_ip" nm_wireguard_peer_append_allowed_ip :: 
    Ptr WireGuardPeer ->                    -- self : TInterface (Name {namespace = "NM", name = "WireGuardPeer"})
    CString ->                              -- allowed_ip : TBasicType TUTF8
    CInt ->                                 -- accept_invalid : TBasicType TBoolean
    IO CInt

-- | Appends /@allowedIp@/ setting to the list. This does not check
-- for duplicates and always appends /@allowedIp@/ to the end of the
-- list. If /@allowedIp@/ is valid, it will be normalized and a modified
-- for might be appended. If /@allowedIp@/ is invalid, it will still be
-- appended, but later verification will fail.
-- 
-- It is a bug trying to modify a sealed t'GI.NM.Structs.WireGuardPeer.WireGuardPeer' instance.
-- 
-- /Since: 1.16/
wireGuardPeerAppendAllowedIp ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    WireGuardPeer
    -- ^ /@self@/: the unsealed t'GI.NM.Structs.WireGuardPeer.WireGuardPeer' instance
    -> T.Text
    -- ^ /@allowedIp@/: the allowed-ip entry to set.
    -> Bool
    -- ^ /@acceptInvalid@/: if 'P.True', also invalid /@allowedIp@/ value
    --   will be appended. Otherwise, the function does nothing
    --   in face of invalid values and returns 'P.False'.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the value is a valid allowed-ips value, 'P.False' otherwise.
    --   Depending on /@acceptInvalid@/, also invalid values are added.
wireGuardPeerAppendAllowedIp :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WireGuardPeer -> Text -> Bool -> m Bool
wireGuardPeerAppendAllowedIp WireGuardPeer
self Text
allowedIp Bool
acceptInvalid = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr WireGuardPeer
self' <- WireGuardPeer -> IO (Ptr WireGuardPeer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WireGuardPeer
self
    CString
allowedIp' <- Text -> IO CString
textToCString Text
allowedIp
    let acceptInvalid' :: CInt
acceptInvalid' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
acceptInvalid
    CInt
result <- Ptr WireGuardPeer -> CString -> CInt -> IO CInt
nm_wireguard_peer_append_allowed_ip Ptr WireGuardPeer
self' CString
allowedIp' CInt
acceptInvalid'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    WireGuardPeer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WireGuardPeer
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
allowedIp'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data WireGuardPeerAppendAllowedIpMethodInfo
instance (signature ~ (T.Text -> Bool -> m Bool), MonadIO m) => O.OverloadedMethod WireGuardPeerAppendAllowedIpMethodInfo WireGuardPeer signature where
    overloadedMethod = wireGuardPeerAppendAllowedIp

instance O.OverloadedMethodInfo WireGuardPeerAppendAllowedIpMethodInfo WireGuardPeer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.WireGuardPeer.wireGuardPeerAppendAllowedIp",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-WireGuardPeer.html#v:wireGuardPeerAppendAllowedIp"
        })


#endif

-- method WireGuardPeer::clear_allowed_ips
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "WireGuardPeer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the unsealed #NMWireGuardPeer 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_wireguard_peer_clear_allowed_ips" nm_wireguard_peer_clear_allowed_ips :: 
    Ptr WireGuardPeer ->                    -- self : TInterface (Name {namespace = "NM", name = "WireGuardPeer"})
    IO ()

-- | Removes all allowed-ip entries.
-- 
-- It is a bug trying to modify a sealed t'GI.NM.Structs.WireGuardPeer.WireGuardPeer' instance.
-- 
-- /Since: 1.16/
wireGuardPeerClearAllowedIps ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    WireGuardPeer
    -- ^ /@self@/: the unsealed t'GI.NM.Structs.WireGuardPeer.WireGuardPeer' instance
    -> m ()
wireGuardPeerClearAllowedIps :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WireGuardPeer -> m ()
wireGuardPeerClearAllowedIps WireGuardPeer
self = 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 WireGuardPeer
self' <- WireGuardPeer -> IO (Ptr WireGuardPeer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WireGuardPeer
self
    Ptr WireGuardPeer -> IO ()
nm_wireguard_peer_clear_allowed_ips Ptr WireGuardPeer
self'
    WireGuardPeer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WireGuardPeer
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data WireGuardPeerClearAllowedIpsMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod WireGuardPeerClearAllowedIpsMethodInfo WireGuardPeer signature where
    overloadedMethod = wireGuardPeerClearAllowedIps

instance O.OverloadedMethodInfo WireGuardPeerClearAllowedIpsMethodInfo WireGuardPeer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.WireGuardPeer.wireGuardPeerClearAllowedIps",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-WireGuardPeer.html#v:wireGuardPeerClearAllowedIps"
        })


#endif

-- method WireGuardPeer::cmp
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "a"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "WireGuardPeer" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMWireGuardPeer to compare."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "b"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "WireGuardPeer" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the other #NMWireGuardPeer to compare."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "compare_flags"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "SettingCompareFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "#NMSettingCompareFlags to affect the comparison."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "nm_wireguard_peer_cmp" nm_wireguard_peer_cmp :: 
    Ptr WireGuardPeer ->                    -- a : TInterface (Name {namespace = "NM", name = "WireGuardPeer"})
    Ptr WireGuardPeer ->                    -- b : TInterface (Name {namespace = "NM", name = "WireGuardPeer"})
    CUInt ->                                -- compare_flags : TInterface (Name {namespace = "NM", name = "SettingCompareFlags"})
    IO Int32

-- | /No description available in the introspection data./
-- 
-- /Since: 1.16/
wireGuardPeerCmp ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Maybe (WireGuardPeer)
    -- ^ /@a@/: the t'GI.NM.Structs.WireGuardPeer.WireGuardPeer' to compare.
    -> Maybe (WireGuardPeer)
    -- ^ /@b@/: the other t'GI.NM.Structs.WireGuardPeer.WireGuardPeer' to compare.
    -> NM.Enums.SettingCompareFlags
    -- ^ /@compareFlags@/: t'GI.NM.Enums.SettingCompareFlags' to affect the comparison.
    -> m Int32
    -- ^ __Returns:__ zero of the two instances are equivalent or
    --   a non-zero integer otherwise. This defines a total ordering
    --   over the peers. Whether a peer is sealed or not, does not
    --   affect the comparison.
wireGuardPeerCmp :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Maybe WireGuardPeer
-> Maybe WireGuardPeer -> SettingCompareFlags -> m Int32
wireGuardPeerCmp Maybe WireGuardPeer
a Maybe WireGuardPeer
b SettingCompareFlags
compareFlags = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr WireGuardPeer
maybeA <- case Maybe WireGuardPeer
a of
        Maybe WireGuardPeer
Nothing -> Ptr WireGuardPeer -> IO (Ptr WireGuardPeer)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr WireGuardPeer
forall a. Ptr a
FP.nullPtr
        Just WireGuardPeer
jA -> do
            Ptr WireGuardPeer
jA' <- WireGuardPeer -> IO (Ptr WireGuardPeer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WireGuardPeer
jA
            Ptr WireGuardPeer -> IO (Ptr WireGuardPeer)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr WireGuardPeer
jA'
    Ptr WireGuardPeer
maybeB <- case Maybe WireGuardPeer
b of
        Maybe WireGuardPeer
Nothing -> Ptr WireGuardPeer -> IO (Ptr WireGuardPeer)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr WireGuardPeer
forall a. Ptr a
FP.nullPtr
        Just WireGuardPeer
jB -> do
            Ptr WireGuardPeer
jB' <- WireGuardPeer -> IO (Ptr WireGuardPeer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WireGuardPeer
jB
            Ptr WireGuardPeer -> IO (Ptr WireGuardPeer)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr WireGuardPeer
jB'
    let compareFlags' :: CUInt
compareFlags' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (SettingCompareFlags -> Int) -> SettingCompareFlags -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SettingCompareFlags -> Int
forall a. Enum a => a -> Int
fromEnum) SettingCompareFlags
compareFlags
    Int32
result <- Ptr WireGuardPeer -> Ptr WireGuardPeer -> CUInt -> IO Int32
nm_wireguard_peer_cmp Ptr WireGuardPeer
maybeA Ptr WireGuardPeer
maybeB CUInt
compareFlags'
    Maybe WireGuardPeer -> (WireGuardPeer -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe WireGuardPeer
a WireGuardPeer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe WireGuardPeer -> (WireGuardPeer -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe WireGuardPeer
b WireGuardPeer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data WireGuardPeerCmpMethodInfo
instance (signature ~ (Maybe (WireGuardPeer) -> NM.Enums.SettingCompareFlags -> m Int32), MonadIO m) => O.OverloadedMethod WireGuardPeerCmpMethodInfo WireGuardPeer signature where
    overloadedMethod i = wireGuardPeerCmp (Just i)

instance O.OverloadedMethodInfo WireGuardPeerCmpMethodInfo WireGuardPeer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.WireGuardPeer.wireGuardPeerCmp",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-WireGuardPeer.html#v:wireGuardPeerCmp"
        })


#endif

-- method WireGuardPeer::get_allowed_ip
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "WireGuardPeer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMWireGuardPeer instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "idx"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the index from zero to (allowed-ips-len - 1) to\n  retrieve."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_is_valid"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "%TRUE if the returned value is a valid allowed-ip\n  setting.\n  This parameter is wrongly not marked as (out) argument, it is\n  thus not accessible via introspection. This cannot be fixed without\n  breaking API for introspection users."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "nm_wireguard_peer_get_allowed_ip" nm_wireguard_peer_get_allowed_ip :: 
    Ptr WireGuardPeer ->                    -- self : TInterface (Name {namespace = "NM", name = "WireGuardPeer"})
    Word32 ->                               -- idx : TBasicType TUInt
    CInt ->                                 -- out_is_valid : TBasicType TBoolean
    IO CString

-- | /No description available in the introspection data./
-- 
-- /Since: 1.16/
wireGuardPeerGetAllowedIp ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    WireGuardPeer
    -- ^ /@self@/: the t'GI.NM.Structs.WireGuardPeer.WireGuardPeer' instance
    -> Word32
    -- ^ /@idx@/: the index from zero to (allowed-ips-len - 1) to
    --   retrieve.
    -> Bool
    -- ^ /@outIsValid@/: 'P.True' if the returned value is a valid allowed-ip
    --   setting.
    --   This parameter is wrongly not marked as (out) argument, it is
    --   thus not accessible via introspection. This cannot be fixed without
    --   breaking API for introspection users.
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the allowed-ip setting at index /@idx@/.
    --   If /@idx@/ is out of range, 'P.Nothing' will be returned.
wireGuardPeerGetAllowedIp :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WireGuardPeer -> Word32 -> Bool -> m (Maybe Text)
wireGuardPeerGetAllowedIp WireGuardPeer
self Word32
idx Bool
outIsValid = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr WireGuardPeer
self' <- WireGuardPeer -> IO (Ptr WireGuardPeer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WireGuardPeer
self
    let outIsValid' :: CInt
outIsValid' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
outIsValid
    CString
result <- Ptr WireGuardPeer -> Word32 -> CInt -> IO CString
nm_wireguard_peer_get_allowed_ip Ptr WireGuardPeer
self' Word32
idx CInt
outIsValid'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    WireGuardPeer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WireGuardPeer
self
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data WireGuardPeerGetAllowedIpMethodInfo
instance (signature ~ (Word32 -> Bool -> m (Maybe T.Text)), MonadIO m) => O.OverloadedMethod WireGuardPeerGetAllowedIpMethodInfo WireGuardPeer signature where
    overloadedMethod = wireGuardPeerGetAllowedIp

instance O.OverloadedMethodInfo WireGuardPeerGetAllowedIpMethodInfo WireGuardPeer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.WireGuardPeer.wireGuardPeerGetAllowedIp",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-WireGuardPeer.html#v:wireGuardPeerGetAllowedIp"
        })


#endif

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

foreign import ccall "nm_wireguard_peer_get_allowed_ips_len" nm_wireguard_peer_get_allowed_ips_len :: 
    Ptr WireGuardPeer ->                    -- self : TInterface (Name {namespace = "NM", name = "WireGuardPeer"})
    IO Word32

-- | /No description available in the introspection data./
-- 
-- /Since: 1.16/
wireGuardPeerGetAllowedIpsLen ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    WireGuardPeer
    -- ^ /@self@/: the t'GI.NM.Structs.WireGuardPeer.WireGuardPeer' instance
    -> m Word32
    -- ^ __Returns:__ the number of allowed-ips entries.
wireGuardPeerGetAllowedIpsLen :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WireGuardPeer -> m Word32
wireGuardPeerGetAllowedIpsLen WireGuardPeer
self = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr WireGuardPeer
self' <- WireGuardPeer -> IO (Ptr WireGuardPeer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WireGuardPeer
self
    Word32
result <- Ptr WireGuardPeer -> IO Word32
nm_wireguard_peer_get_allowed_ips_len Ptr WireGuardPeer
self'
    WireGuardPeer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WireGuardPeer
self
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data WireGuardPeerGetAllowedIpsLenMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.OverloadedMethod WireGuardPeerGetAllowedIpsLenMethodInfo WireGuardPeer signature where
    overloadedMethod = wireGuardPeerGetAllowedIpsLen

instance O.OverloadedMethodInfo WireGuardPeerGetAllowedIpsLenMethodInfo WireGuardPeer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.WireGuardPeer.wireGuardPeerGetAllowedIpsLen",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-WireGuardPeer.html#v:wireGuardPeerGetAllowedIpsLen"
        })


#endif

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

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

-- | /No description available in the introspection data./
-- 
-- /Since: 1.16/
wireGuardPeerGetEndpoint ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    WireGuardPeer
    -- ^ /@self@/: the t'GI.NM.Structs.WireGuardPeer.WireGuardPeer' instance
    -> m T.Text
    -- ^ __Returns:__ the endpoint or 'P.Nothing' if none was set.
wireGuardPeerGetEndpoint :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WireGuardPeer -> m Text
wireGuardPeerGetEndpoint WireGuardPeer
self = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr WireGuardPeer
self' <- WireGuardPeer -> IO (Ptr WireGuardPeer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WireGuardPeer
self
    CString
result <- Ptr WireGuardPeer -> IO CString
nm_wireguard_peer_get_endpoint Ptr WireGuardPeer
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"wireGuardPeerGetEndpoint" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    WireGuardPeer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WireGuardPeer
self
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data WireGuardPeerGetEndpointMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod WireGuardPeerGetEndpointMethodInfo WireGuardPeer signature where
    overloadedMethod = wireGuardPeerGetEndpoint

instance O.OverloadedMethodInfo WireGuardPeerGetEndpointMethodInfo WireGuardPeer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.WireGuardPeer.wireGuardPeerGetEndpoint",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-WireGuardPeer.html#v:wireGuardPeerGetEndpoint"
        })


#endif

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

foreign import ccall "nm_wireguard_peer_get_persistent_keepalive" nm_wireguard_peer_get_persistent_keepalive :: 
    Ptr WireGuardPeer ->                    -- self : TInterface (Name {namespace = "NM", name = "WireGuardPeer"})
    IO Word16

-- | /No description available in the introspection data./
-- 
-- /Since: 1.16/
wireGuardPeerGetPersistentKeepalive ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    WireGuardPeer
    -- ^ /@self@/: the t'GI.NM.Structs.WireGuardPeer.WireGuardPeer' instance
    -> m Word16
    -- ^ __Returns:__ get the persistent-keepalive setting in seconds. Set to zero to disable
    --   keep-alive.
wireGuardPeerGetPersistentKeepalive :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WireGuardPeer -> m Word16
wireGuardPeerGetPersistentKeepalive WireGuardPeer
self = IO Word16 -> m Word16
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word16 -> m Word16) -> IO Word16 -> m Word16
forall a b. (a -> b) -> a -> b
$ do
    Ptr WireGuardPeer
self' <- WireGuardPeer -> IO (Ptr WireGuardPeer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WireGuardPeer
self
    Word16
result <- Ptr WireGuardPeer -> IO Word16
nm_wireguard_peer_get_persistent_keepalive Ptr WireGuardPeer
self'
    WireGuardPeer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WireGuardPeer
self
    Word16 -> IO Word16
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word16
result

#if defined(ENABLE_OVERLOADING)
data WireGuardPeerGetPersistentKeepaliveMethodInfo
instance (signature ~ (m Word16), MonadIO m) => O.OverloadedMethod WireGuardPeerGetPersistentKeepaliveMethodInfo WireGuardPeer signature where
    overloadedMethod = wireGuardPeerGetPersistentKeepalive

instance O.OverloadedMethodInfo WireGuardPeerGetPersistentKeepaliveMethodInfo WireGuardPeer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.WireGuardPeer.wireGuardPeerGetPersistentKeepalive",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-WireGuardPeer.html#v:wireGuardPeerGetPersistentKeepalive"
        })


#endif

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

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

-- | /No description available in the introspection data./
-- 
-- /Since: 1.16/
wireGuardPeerGetPresharedKey ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    WireGuardPeer
    -- ^ /@self@/: the t'GI.NM.Structs.WireGuardPeer.WireGuardPeer' instance
    -> m T.Text
    -- ^ __Returns:__ the preshared key or 'P.Nothing' if unset.
wireGuardPeerGetPresharedKey :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WireGuardPeer -> m Text
wireGuardPeerGetPresharedKey WireGuardPeer
self = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr WireGuardPeer
self' <- WireGuardPeer -> IO (Ptr WireGuardPeer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WireGuardPeer
self
    CString
result <- Ptr WireGuardPeer -> IO CString
nm_wireguard_peer_get_preshared_key Ptr WireGuardPeer
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"wireGuardPeerGetPresharedKey" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    WireGuardPeer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WireGuardPeer
self
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data WireGuardPeerGetPresharedKeyMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod WireGuardPeerGetPresharedKeyMethodInfo WireGuardPeer signature where
    overloadedMethod = wireGuardPeerGetPresharedKey

instance O.OverloadedMethodInfo WireGuardPeerGetPresharedKeyMethodInfo WireGuardPeer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.WireGuardPeer.wireGuardPeerGetPresharedKey",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-WireGuardPeer.html#v:wireGuardPeerGetPresharedKey"
        })


#endif

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

foreign import ccall "nm_wireguard_peer_get_preshared_key_flags" nm_wireguard_peer_get_preshared_key_flags :: 
    Ptr WireGuardPeer ->                    -- self : TInterface (Name {namespace = "NM", name = "WireGuardPeer"})
    IO CUInt

-- | /No description available in the introspection data./
-- 
-- /Since: 1.16/
wireGuardPeerGetPresharedKeyFlags ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    WireGuardPeer
    -- ^ /@self@/: the t'GI.NM.Structs.WireGuardPeer.WireGuardPeer' instance
    -> m [NM.Flags.SettingSecretFlags]
    -- ^ __Returns:__ get the secret flags for the preshared-key.
wireGuardPeerGetPresharedKeyFlags :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WireGuardPeer -> m [SettingSecretFlags]
wireGuardPeerGetPresharedKeyFlags WireGuardPeer
self = IO [SettingSecretFlags] -> m [SettingSecretFlags]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [SettingSecretFlags] -> m [SettingSecretFlags])
-> IO [SettingSecretFlags] -> m [SettingSecretFlags]
forall a b. (a -> b) -> a -> b
$ do
    Ptr WireGuardPeer
self' <- WireGuardPeer -> IO (Ptr WireGuardPeer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WireGuardPeer
self
    CUInt
result <- Ptr WireGuardPeer -> IO CUInt
nm_wireguard_peer_get_preshared_key_flags Ptr WireGuardPeer
self'
    let result' :: [SettingSecretFlags]
result' = CUInt -> [SettingSecretFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    WireGuardPeer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WireGuardPeer
self
    [SettingSecretFlags] -> IO [SettingSecretFlags]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [SettingSecretFlags]
result'

#if defined(ENABLE_OVERLOADING)
data WireGuardPeerGetPresharedKeyFlagsMethodInfo
instance (signature ~ (m [NM.Flags.SettingSecretFlags]), MonadIO m) => O.OverloadedMethod WireGuardPeerGetPresharedKeyFlagsMethodInfo WireGuardPeer signature where
    overloadedMethod = wireGuardPeerGetPresharedKeyFlags

instance O.OverloadedMethodInfo WireGuardPeerGetPresharedKeyFlagsMethodInfo WireGuardPeer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.WireGuardPeer.wireGuardPeerGetPresharedKeyFlags",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-WireGuardPeer.html#v:wireGuardPeerGetPresharedKeyFlags"
        })


#endif

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

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

-- | /No description available in the introspection data./
-- 
-- /Since: 1.16/
wireGuardPeerGetPublicKey ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    WireGuardPeer
    -- ^ /@self@/: the t'GI.NM.Structs.WireGuardPeer.WireGuardPeer' instance
    -> m T.Text
    -- ^ __Returns:__ the public key or 'P.Nothing' if unset.
wireGuardPeerGetPublicKey :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WireGuardPeer -> m Text
wireGuardPeerGetPublicKey WireGuardPeer
self = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr WireGuardPeer
self' <- WireGuardPeer -> IO (Ptr WireGuardPeer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WireGuardPeer
self
    CString
result <- Ptr WireGuardPeer -> IO CString
nm_wireguard_peer_get_public_key Ptr WireGuardPeer
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"wireGuardPeerGetPublicKey" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    WireGuardPeer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WireGuardPeer
self
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data WireGuardPeerGetPublicKeyMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod WireGuardPeerGetPublicKeyMethodInfo WireGuardPeer signature where
    overloadedMethod = wireGuardPeerGetPublicKey

instance O.OverloadedMethodInfo WireGuardPeerGetPublicKeyMethodInfo WireGuardPeer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.WireGuardPeer.wireGuardPeerGetPublicKey",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-WireGuardPeer.html#v:wireGuardPeerGetPublicKey"
        })


#endif

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

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

-- | /No description available in the introspection data./
-- 
-- /Since: 1.16/
wireGuardPeerIsSealed ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    WireGuardPeer
    -- ^ /@self@/: the t'GI.NM.Structs.WireGuardPeer.WireGuardPeer' instance
    -> m Bool
    -- ^ __Returns:__ whether /@self@/ is sealed or not.
wireGuardPeerIsSealed :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WireGuardPeer -> m Bool
wireGuardPeerIsSealed WireGuardPeer
self = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr WireGuardPeer
self' <- WireGuardPeer -> IO (Ptr WireGuardPeer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WireGuardPeer
self
    CInt
result <- Ptr WireGuardPeer -> IO CInt
nm_wireguard_peer_is_sealed Ptr WireGuardPeer
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    WireGuardPeer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WireGuardPeer
self
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data WireGuardPeerIsSealedMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod WireGuardPeerIsSealedMethodInfo WireGuardPeer signature where
    overloadedMethod = wireGuardPeerIsSealed

instance O.OverloadedMethodInfo WireGuardPeerIsSealedMethodInfo WireGuardPeer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.WireGuardPeer.wireGuardPeerIsSealed",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-WireGuardPeer.html#v:wireGuardPeerIsSealed"
        })


#endif

-- method WireGuardPeer::is_valid
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "WireGuardPeer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMWireGuardPeer instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "check_non_secrets"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "if %TRUE, secret properties are validated.\n  Otherwise, they are ignored for this purpose."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "check_secrets"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "if %TRUE, non-secret properties are validated.\n  Otherwise, they are ignored for this purpose."
--                 , 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_wireguard_peer_is_valid" nm_wireguard_peer_is_valid :: 
    Ptr WireGuardPeer ->                    -- self : TInterface (Name {namespace = "NM", name = "WireGuardPeer"})
    CInt ->                                 -- check_non_secrets : TBasicType TBoolean
    CInt ->                                 -- check_secrets : TBasicType TBoolean
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | /No description available in the introspection data./
-- 
-- /Since: 1.16/
wireGuardPeerIsValid ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    WireGuardPeer
    -- ^ /@self@/: the t'GI.NM.Structs.WireGuardPeer.WireGuardPeer' instance
    -> Bool
    -- ^ /@checkNonSecrets@/: if 'P.True', secret properties are validated.
    --   Otherwise, they are ignored for this purpose.
    -> Bool
    -- ^ /@checkSecrets@/: if 'P.True', non-secret properties are validated.
    --   Otherwise, they are ignored for this purpose.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
wireGuardPeerIsValid :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WireGuardPeer -> Bool -> Bool -> m ()
wireGuardPeerIsValid WireGuardPeer
self Bool
checkNonSecrets Bool
checkSecrets = 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 WireGuardPeer
self' <- WireGuardPeer -> IO (Ptr WireGuardPeer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WireGuardPeer
self
    let checkNonSecrets' :: CInt
checkNonSecrets' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
checkNonSecrets
    let checkSecrets' :: CInt
checkSecrets' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
checkSecrets
    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 WireGuardPeer -> CInt -> CInt -> Ptr (Ptr GError) -> IO CInt
nm_wireguard_peer_is_valid Ptr WireGuardPeer
self' CInt
checkNonSecrets' CInt
checkSecrets'
        WireGuardPeer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WireGuardPeer
self
        () -> 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 WireGuardPeerIsValidMethodInfo
instance (signature ~ (Bool -> Bool -> m ()), MonadIO m) => O.OverloadedMethod WireGuardPeerIsValidMethodInfo WireGuardPeer signature where
    overloadedMethod = wireGuardPeerIsValid

instance O.OverloadedMethodInfo WireGuardPeerIsValidMethodInfo WireGuardPeer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.WireGuardPeer.wireGuardPeerIsValid",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-WireGuardPeer.html#v:wireGuardPeerIsValid"
        })


#endif

-- method WireGuardPeer::new_clone
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "WireGuardPeer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMWireGuardPeer instance to copy."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "with_secrets"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "if %TRUE, the preshared-key secrets are copied\n as well. Otherwise, they will be removed."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "NM" , name = "WireGuardPeer" })
-- throws : False
-- Skip return : False

foreign import ccall "nm_wireguard_peer_new_clone" nm_wireguard_peer_new_clone :: 
    Ptr WireGuardPeer ->                    -- self : TInterface (Name {namespace = "NM", name = "WireGuardPeer"})
    CInt ->                                 -- with_secrets : TBasicType TBoolean
    IO (Ptr WireGuardPeer)

-- | /No description available in the introspection data./
-- 
-- /Since: 1.16/
wireGuardPeerNewClone ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    WireGuardPeer
    -- ^ /@self@/: the t'GI.NM.Structs.WireGuardPeer.WireGuardPeer' instance to copy.
    -> Bool
    -- ^ /@withSecrets@/: if 'P.True', the preshared-key secrets are copied
    --  as well. Otherwise, they will be removed.
    -> m WireGuardPeer
    -- ^ __Returns:__ a clone of /@self@/. This instance
    --   is always unsealed.
wireGuardPeerNewClone :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WireGuardPeer -> Bool -> m WireGuardPeer
wireGuardPeerNewClone WireGuardPeer
self Bool
withSecrets = IO WireGuardPeer -> m WireGuardPeer
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO WireGuardPeer -> m WireGuardPeer)
-> IO WireGuardPeer -> m WireGuardPeer
forall a b. (a -> b) -> a -> b
$ do
    Ptr WireGuardPeer
self' <- WireGuardPeer -> IO (Ptr WireGuardPeer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WireGuardPeer
self
    let withSecrets' :: CInt
withSecrets' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
withSecrets
    Ptr WireGuardPeer
result <- Ptr WireGuardPeer -> CInt -> IO (Ptr WireGuardPeer)
nm_wireguard_peer_new_clone Ptr WireGuardPeer
self' CInt
withSecrets'
    Text -> Ptr WireGuardPeer -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"wireGuardPeerNewClone" Ptr WireGuardPeer
result
    WireGuardPeer
result' <- ((ManagedPtr WireGuardPeer -> WireGuardPeer)
-> Ptr WireGuardPeer -> IO WireGuardPeer
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr WireGuardPeer -> WireGuardPeer
WireGuardPeer) Ptr WireGuardPeer
result
    WireGuardPeer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WireGuardPeer
self
    WireGuardPeer -> IO WireGuardPeer
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return WireGuardPeer
result'

#if defined(ENABLE_OVERLOADING)
data WireGuardPeerNewCloneMethodInfo
instance (signature ~ (Bool -> m WireGuardPeer), MonadIO m) => O.OverloadedMethod WireGuardPeerNewCloneMethodInfo WireGuardPeer signature where
    overloadedMethod = wireGuardPeerNewClone

instance O.OverloadedMethodInfo WireGuardPeerNewCloneMethodInfo WireGuardPeer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.WireGuardPeer.wireGuardPeerNewClone",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-WireGuardPeer.html#v:wireGuardPeerNewClone"
        })


#endif

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

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

-- | /No description available in the introspection data./
-- 
-- /Since: 1.16/
wireGuardPeerRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Maybe (WireGuardPeer)
    -- ^ /@self@/: the t'GI.NM.Structs.WireGuardPeer.WireGuardPeer' instance
    -> m WireGuardPeer
    -- ^ __Returns:__ returns the input argument /@self@/ after incrementing
    --   the reference count.
    -- 
    -- Since 1.42, ref-counting of t'GI.NM.Structs.WireGuardPeer.WireGuardPeer' is thread-safe.
wireGuardPeerRef :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Maybe WireGuardPeer -> m WireGuardPeer
wireGuardPeerRef Maybe WireGuardPeer
self = IO WireGuardPeer -> m WireGuardPeer
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO WireGuardPeer -> m WireGuardPeer)
-> IO WireGuardPeer -> m WireGuardPeer
forall a b. (a -> b) -> a -> b
$ do
    Ptr WireGuardPeer
maybeSelf <- case Maybe WireGuardPeer
self of
        Maybe WireGuardPeer
Nothing -> Ptr WireGuardPeer -> IO (Ptr WireGuardPeer)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr WireGuardPeer
forall a. Ptr a
FP.nullPtr
        Just WireGuardPeer
jSelf -> do
            Ptr WireGuardPeer
jSelf' <- WireGuardPeer -> IO (Ptr WireGuardPeer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WireGuardPeer
jSelf
            Ptr WireGuardPeer -> IO (Ptr WireGuardPeer)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr WireGuardPeer
jSelf'
    Ptr WireGuardPeer
result <- Ptr WireGuardPeer -> IO (Ptr WireGuardPeer)
nm_wireguard_peer_ref Ptr WireGuardPeer
maybeSelf
    Text -> Ptr WireGuardPeer -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"wireGuardPeerRef" Ptr WireGuardPeer
result
    WireGuardPeer
result' <- ((ManagedPtr WireGuardPeer -> WireGuardPeer)
-> Ptr WireGuardPeer -> IO WireGuardPeer
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr WireGuardPeer -> WireGuardPeer
WireGuardPeer) Ptr WireGuardPeer
result
    Maybe WireGuardPeer -> (WireGuardPeer -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe WireGuardPeer
self WireGuardPeer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    WireGuardPeer -> IO WireGuardPeer
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return WireGuardPeer
result'

#if defined(ENABLE_OVERLOADING)
data WireGuardPeerRefMethodInfo
instance (signature ~ (m WireGuardPeer), MonadIO m) => O.OverloadedMethod WireGuardPeerRefMethodInfo WireGuardPeer signature where
    overloadedMethod i = wireGuardPeerRef (Just i)

instance O.OverloadedMethodInfo WireGuardPeerRefMethodInfo WireGuardPeer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.WireGuardPeer.wireGuardPeerRef",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-WireGuardPeer.html#v:wireGuardPeerRef"
        })


#endif

-- method WireGuardPeer::remove_allowed_ip
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "WireGuardPeer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the unsealed #NMWireGuardPeer instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "idx"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the index from zero to (allowed-ips-len - 1) to\n  retrieve. If the index is out of range, %FALSE is returned\n  and nothing is done."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "nm_wireguard_peer_remove_allowed_ip" nm_wireguard_peer_remove_allowed_ip :: 
    Ptr WireGuardPeer ->                    -- self : TInterface (Name {namespace = "NM", name = "WireGuardPeer"})
    Word32 ->                               -- idx : TBasicType TUInt
    IO CInt

-- | Removes the allowed-ip at the given /@idx@/. This shifts all
-- following entries one index down.
-- 
-- It is a bug trying to modify a sealed t'GI.NM.Structs.WireGuardPeer.WireGuardPeer' instance.
-- 
-- /Since: 1.16/
wireGuardPeerRemoveAllowedIp ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    WireGuardPeer
    -- ^ /@self@/: the unsealed t'GI.NM.Structs.WireGuardPeer.WireGuardPeer' instance
    -> Word32
    -- ^ /@idx@/: the index from zero to (allowed-ips-len - 1) to
    --   retrieve. If the index is out of range, 'P.False' is returned
    --   and nothing is done.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@idx@/ was valid and the allowed-ip was removed.
    --   'P.False' otherwise, and the peer will not be changed.
wireGuardPeerRemoveAllowedIp :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WireGuardPeer -> Word32 -> m Bool
wireGuardPeerRemoveAllowedIp WireGuardPeer
self Word32
idx = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr WireGuardPeer
self' <- WireGuardPeer -> IO (Ptr WireGuardPeer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WireGuardPeer
self
    CInt
result <- Ptr WireGuardPeer -> Word32 -> IO CInt
nm_wireguard_peer_remove_allowed_ip Ptr WireGuardPeer
self' Word32
idx
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    WireGuardPeer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WireGuardPeer
self
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data WireGuardPeerRemoveAllowedIpMethodInfo
instance (signature ~ (Word32 -> m Bool), MonadIO m) => O.OverloadedMethod WireGuardPeerRemoveAllowedIpMethodInfo WireGuardPeer signature where
    overloadedMethod = wireGuardPeerRemoveAllowedIp

instance O.OverloadedMethodInfo WireGuardPeerRemoveAllowedIpMethodInfo WireGuardPeer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.WireGuardPeer.wireGuardPeerRemoveAllowedIp",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-WireGuardPeer.html#v:wireGuardPeerRemoveAllowedIp"
        })


#endif

-- method WireGuardPeer::seal
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "WireGuardPeer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMWireGuardPeer 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_wireguard_peer_seal" nm_wireguard_peer_seal :: 
    Ptr WireGuardPeer ->                    -- self : TInterface (Name {namespace = "NM", name = "WireGuardPeer"})
    IO ()

-- | Seal the t'GI.NM.Structs.WireGuardPeer.WireGuardPeer' instance. Afterwards, it is a bug
-- to call all functions that modify the instance (except ref\/unref).
-- A sealed instance cannot be unsealed again, but you can create
-- an unsealed copy with 'GI.NM.Structs.WireGuardPeer.wireGuardPeerNewClone'.
-- 
-- /Since: 1.16/
wireGuardPeerSeal ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    WireGuardPeer
    -- ^ /@self@/: the t'GI.NM.Structs.WireGuardPeer.WireGuardPeer' instance
    -> m ()
wireGuardPeerSeal :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WireGuardPeer -> m ()
wireGuardPeerSeal WireGuardPeer
self = 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 WireGuardPeer
self' <- WireGuardPeer -> IO (Ptr WireGuardPeer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WireGuardPeer
self
    Ptr WireGuardPeer -> IO ()
nm_wireguard_peer_seal Ptr WireGuardPeer
self'
    WireGuardPeer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WireGuardPeer
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data WireGuardPeerSealMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod WireGuardPeerSealMethodInfo WireGuardPeer signature where
    overloadedMethod = wireGuardPeerSeal

instance O.OverloadedMethodInfo WireGuardPeerSealMethodInfo WireGuardPeer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.WireGuardPeer.wireGuardPeerSeal",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-WireGuardPeer.html#v:wireGuardPeerSeal"
        })


#endif

-- method WireGuardPeer::set_endpoint
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "WireGuardPeer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the unsealed #NMWireGuardPeer instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "endpoint"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the socket address endpoint to set or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "allow_invalid"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "if %TRUE, also invalid values are set.\n  If %FALSE, the function does nothing for invalid @endpoint\n  arguments."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "nm_wireguard_peer_set_endpoint" nm_wireguard_peer_set_endpoint :: 
    Ptr WireGuardPeer ->                    -- self : TInterface (Name {namespace = "NM", name = "WireGuardPeer"})
    CString ->                              -- endpoint : TBasicType TUTF8
    CInt ->                                 -- allow_invalid : TBasicType TBoolean
    IO CInt

-- | Sets or clears the endpoint of /@self@/.
-- 
-- It is a bug trying to modify a sealed t'GI.NM.Structs.WireGuardPeer.WireGuardPeer' instance.
-- 
-- /Since: 1.16/
wireGuardPeerSetEndpoint ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    WireGuardPeer
    -- ^ /@self@/: the unsealed t'GI.NM.Structs.WireGuardPeer.WireGuardPeer' instance
    -> T.Text
    -- ^ /@endpoint@/: the socket address endpoint to set or 'P.Nothing'.
    -> Bool
    -- ^ /@allowInvalid@/: if 'P.True', also invalid values are set.
    --   If 'P.False', the function does nothing for invalid /@endpoint@/
    --   arguments.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the endpoint is 'P.Nothing' or valid. For an
    --   invalid /@endpoint@/ argument, 'P.False' is returned. Depending
    --   on /@allowInvalid@/, the instance will be modified.
wireGuardPeerSetEndpoint :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WireGuardPeer -> Text -> Bool -> m Bool
wireGuardPeerSetEndpoint WireGuardPeer
self Text
endpoint Bool
allowInvalid = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr WireGuardPeer
self' <- WireGuardPeer -> IO (Ptr WireGuardPeer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WireGuardPeer
self
    CString
endpoint' <- Text -> IO CString
textToCString Text
endpoint
    let allowInvalid' :: CInt
allowInvalid' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
allowInvalid
    CInt
result <- Ptr WireGuardPeer -> CString -> CInt -> IO CInt
nm_wireguard_peer_set_endpoint Ptr WireGuardPeer
self' CString
endpoint' CInt
allowInvalid'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    WireGuardPeer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WireGuardPeer
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
endpoint'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data WireGuardPeerSetEndpointMethodInfo
instance (signature ~ (T.Text -> Bool -> m Bool), MonadIO m) => O.OverloadedMethod WireGuardPeerSetEndpointMethodInfo WireGuardPeer signature where
    overloadedMethod = wireGuardPeerSetEndpoint

instance O.OverloadedMethodInfo WireGuardPeerSetEndpointMethodInfo WireGuardPeer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.WireGuardPeer.wireGuardPeerSetEndpoint",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-WireGuardPeer.html#v:wireGuardPeerSetEndpoint"
        })


#endif

-- method WireGuardPeer::set_persistent_keepalive
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "WireGuardPeer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the unsealed #NMWireGuardPeer instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "persistent_keepalive"
--           , argType = TBasicType TUInt16
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the keep-alive value to set."
--                 , 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_wireguard_peer_set_persistent_keepalive" nm_wireguard_peer_set_persistent_keepalive :: 
    Ptr WireGuardPeer ->                    -- self : TInterface (Name {namespace = "NM", name = "WireGuardPeer"})
    Word16 ->                               -- persistent_keepalive : TBasicType TUInt16
    IO ()

-- | It is a bug trying to modify a sealed t'GI.NM.Structs.WireGuardPeer.WireGuardPeer' instance.
-- 
-- /Since: 1.16/
wireGuardPeerSetPersistentKeepalive ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    WireGuardPeer
    -- ^ /@self@/: the unsealed t'GI.NM.Structs.WireGuardPeer.WireGuardPeer' instance
    -> Word16
    -- ^ /@persistentKeepalive@/: the keep-alive value to set.
    -> m ()
wireGuardPeerSetPersistentKeepalive :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WireGuardPeer -> Word16 -> m ()
wireGuardPeerSetPersistentKeepalive WireGuardPeer
self Word16
persistentKeepalive = 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 WireGuardPeer
self' <- WireGuardPeer -> IO (Ptr WireGuardPeer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WireGuardPeer
self
    Ptr WireGuardPeer -> Word16 -> IO ()
nm_wireguard_peer_set_persistent_keepalive Ptr WireGuardPeer
self' Word16
persistentKeepalive
    WireGuardPeer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WireGuardPeer
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data WireGuardPeerSetPersistentKeepaliveMethodInfo
instance (signature ~ (Word16 -> m ()), MonadIO m) => O.OverloadedMethod WireGuardPeerSetPersistentKeepaliveMethodInfo WireGuardPeer signature where
    overloadedMethod = wireGuardPeerSetPersistentKeepalive

instance O.OverloadedMethodInfo WireGuardPeerSetPersistentKeepaliveMethodInfo WireGuardPeer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.WireGuardPeer.wireGuardPeerSetPersistentKeepalive",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-WireGuardPeer.html#v:wireGuardPeerSetPersistentKeepalive"
        })


#endif

-- method WireGuardPeer::set_preshared_key
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "WireGuardPeer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the unsealed #NMWireGuardPeer instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "preshared_key"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the new preshared\n  key or %NULL to clear the preshared key."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "accept_invalid"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "whether to allow setting the key to an invalid\n  value. If %FALSE, @self is unchanged if the key is invalid\n  and if %FALSE is returned."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "nm_wireguard_peer_set_preshared_key" nm_wireguard_peer_set_preshared_key :: 
    Ptr WireGuardPeer ->                    -- self : TInterface (Name {namespace = "NM", name = "WireGuardPeer"})
    CString ->                              -- preshared_key : TBasicType TUTF8
    CInt ->                                 -- accept_invalid : TBasicType TBoolean
    IO CInt

-- | Reset the preshared key. Note that if the preshared key is valid, it
-- will be normalized (which may or may not modify the set value).
-- 
-- Note that the preshared-key is a secret and consequently has corresponding
-- preshared-key-flags property. This is so that secrets can be optional
-- and requested on demand from a secret-agent. Also, an invalid  preshared-key
-- may optionally cause 'GI.NM.Structs.WireGuardPeer.wireGuardPeerIsValid' to fail or it may
-- be accepted.
-- 
-- It is a bug trying to modify a sealed t'GI.NM.Structs.WireGuardPeer.WireGuardPeer' instance.
-- 
-- /Since: 1.16/
wireGuardPeerSetPresharedKey ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    WireGuardPeer
    -- ^ /@self@/: the unsealed t'GI.NM.Structs.WireGuardPeer.WireGuardPeer' instance
    -> Maybe (T.Text)
    -- ^ /@presharedKey@/: the new preshared
    --   key or 'P.Nothing' to clear the preshared key.
    -> Bool
    -- ^ /@acceptInvalid@/: whether to allow setting the key to an invalid
    --   value. If 'P.False', /@self@/ is unchanged if the key is invalid
    --   and if 'P.False' is returned.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the preshared-key is valid, otherwise 'P.False'.
    --   'P.Nothing' is considered a valid value.
    --   If the key is invalid, it depends on /@acceptInvalid@/ whether the
    --   previous value was reset.
wireGuardPeerSetPresharedKey :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WireGuardPeer -> Maybe Text -> Bool -> m Bool
wireGuardPeerSetPresharedKey WireGuardPeer
self Maybe Text
presharedKey Bool
acceptInvalid = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr WireGuardPeer
self' <- WireGuardPeer -> IO (Ptr WireGuardPeer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WireGuardPeer
self
    CString
maybePresharedKey <- case Maybe Text
presharedKey of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
FP.nullPtr
        Just Text
jPresharedKey -> do
            CString
jPresharedKey' <- Text -> IO CString
textToCString Text
jPresharedKey
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jPresharedKey'
    let acceptInvalid' :: CInt
acceptInvalid' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
acceptInvalid
    CInt
result <- Ptr WireGuardPeer -> CString -> CInt -> IO CInt
nm_wireguard_peer_set_preshared_key Ptr WireGuardPeer
self' CString
maybePresharedKey CInt
acceptInvalid'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    WireGuardPeer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WireGuardPeer
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybePresharedKey
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data WireGuardPeerSetPresharedKeyMethodInfo
instance (signature ~ (Maybe (T.Text) -> Bool -> m Bool), MonadIO m) => O.OverloadedMethod WireGuardPeerSetPresharedKeyMethodInfo WireGuardPeer signature where
    overloadedMethod = wireGuardPeerSetPresharedKey

instance O.OverloadedMethodInfo WireGuardPeerSetPresharedKeyMethodInfo WireGuardPeer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.WireGuardPeer.wireGuardPeerSetPresharedKey",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-WireGuardPeer.html#v:wireGuardPeerSetPresharedKey"
        })


#endif

-- method WireGuardPeer::set_preshared_key_flags
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "WireGuardPeer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the unsealed #NMWireGuardPeer instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "preshared_key_flags"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "SettingSecretFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret flags to set."
--                 , 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_wireguard_peer_set_preshared_key_flags" nm_wireguard_peer_set_preshared_key_flags :: 
    Ptr WireGuardPeer ->                    -- self : TInterface (Name {namespace = "NM", name = "WireGuardPeer"})
    CUInt ->                                -- preshared_key_flags : TInterface (Name {namespace = "NM", name = "SettingSecretFlags"})
    IO ()

-- | It is a bug trying to modify a sealed t'GI.NM.Structs.WireGuardPeer.WireGuardPeer' instance.
-- 
-- /Since: 1.16/
wireGuardPeerSetPresharedKeyFlags ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    WireGuardPeer
    -- ^ /@self@/: the unsealed t'GI.NM.Structs.WireGuardPeer.WireGuardPeer' instance
    -> [NM.Flags.SettingSecretFlags]
    -- ^ /@presharedKeyFlags@/: the secret flags to set.
    -> m ()
wireGuardPeerSetPresharedKeyFlags :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WireGuardPeer -> [SettingSecretFlags] -> m ()
wireGuardPeerSetPresharedKeyFlags WireGuardPeer
self [SettingSecretFlags]
presharedKeyFlags = 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 WireGuardPeer
self' <- WireGuardPeer -> IO (Ptr WireGuardPeer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WireGuardPeer
self
    let presharedKeyFlags' :: CUInt
presharedKeyFlags' = [SettingSecretFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [SettingSecretFlags]
presharedKeyFlags
    Ptr WireGuardPeer -> CUInt -> IO ()
nm_wireguard_peer_set_preshared_key_flags Ptr WireGuardPeer
self' CUInt
presharedKeyFlags'
    WireGuardPeer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WireGuardPeer
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data WireGuardPeerSetPresharedKeyFlagsMethodInfo
instance (signature ~ ([NM.Flags.SettingSecretFlags] -> m ()), MonadIO m) => O.OverloadedMethod WireGuardPeerSetPresharedKeyFlagsMethodInfo WireGuardPeer signature where
    overloadedMethod = wireGuardPeerSetPresharedKeyFlags

instance O.OverloadedMethodInfo WireGuardPeerSetPresharedKeyFlagsMethodInfo WireGuardPeer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.WireGuardPeer.wireGuardPeerSetPresharedKeyFlags",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-WireGuardPeer.html#v:wireGuardPeerSetPresharedKeyFlags"
        })


#endif

-- method WireGuardPeer::set_public_key
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "WireGuardPeer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the unsealed #NMWireGuardPeer instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "public_key"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the new public\n  key or %NULL to clear the public key."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "accept_invalid"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "if %TRUE and @public_key is not %NULL and\n  invalid, then do not modify the instance."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "nm_wireguard_peer_set_public_key" nm_wireguard_peer_set_public_key :: 
    Ptr WireGuardPeer ->                    -- self : TInterface (Name {namespace = "NM", name = "WireGuardPeer"})
    CString ->                              -- public_key : TBasicType TUTF8
    CInt ->                                 -- accept_invalid : TBasicType TBoolean
    IO CInt

-- | Reset the public key. Note that if the public key is valid, it
-- will be normalized (which may or may not modify the set value).
-- 
-- It is a bug trying to modify a sealed t'GI.NM.Structs.WireGuardPeer.WireGuardPeer' instance.
-- 
-- /Since: 1.16/
wireGuardPeerSetPublicKey ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    WireGuardPeer
    -- ^ /@self@/: the unsealed t'GI.NM.Structs.WireGuardPeer.WireGuardPeer' instance
    -> Maybe (T.Text)
    -- ^ /@publicKey@/: the new public
    --   key or 'P.Nothing' to clear the public key.
    -> Bool
    -- ^ /@acceptInvalid@/: if 'P.True' and /@publicKey@/ is not 'P.Nothing' and
    --   invalid, then do not modify the instance.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the key was valid or 'P.Nothing'. Returns
    --   'P.False' for invalid keys. Depending on /@acceptInvalid@/
    --   will an invalid key be set or not.
wireGuardPeerSetPublicKey :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WireGuardPeer -> Maybe Text -> Bool -> m Bool
wireGuardPeerSetPublicKey WireGuardPeer
self Maybe Text
publicKey Bool
acceptInvalid = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr WireGuardPeer
self' <- WireGuardPeer -> IO (Ptr WireGuardPeer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WireGuardPeer
self
    CString
maybePublicKey <- case Maybe Text
publicKey of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
FP.nullPtr
        Just Text
jPublicKey -> do
            CString
jPublicKey' <- Text -> IO CString
textToCString Text
jPublicKey
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jPublicKey'
    let acceptInvalid' :: CInt
acceptInvalid' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
acceptInvalid
    CInt
result <- Ptr WireGuardPeer -> CString -> CInt -> IO CInt
nm_wireguard_peer_set_public_key Ptr WireGuardPeer
self' CString
maybePublicKey CInt
acceptInvalid'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    WireGuardPeer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr WireGuardPeer
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybePublicKey
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data WireGuardPeerSetPublicKeyMethodInfo
instance (signature ~ (Maybe (T.Text) -> Bool -> m Bool), MonadIO m) => O.OverloadedMethod WireGuardPeerSetPublicKeyMethodInfo WireGuardPeer signature where
    overloadedMethod = wireGuardPeerSetPublicKey

instance O.OverloadedMethodInfo WireGuardPeerSetPublicKeyMethodInfo WireGuardPeer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.WireGuardPeer.wireGuardPeerSetPublicKey",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-WireGuardPeer.html#v:wireGuardPeerSetPublicKey"
        })


#endif

-- method WireGuardPeer::unref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "WireGuardPeer" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMWireGuardPeer 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_wireguard_peer_unref" nm_wireguard_peer_unref :: 
    Ptr WireGuardPeer ->                    -- self : TInterface (Name {namespace = "NM", name = "WireGuardPeer"})
    IO ()

-- | Drop a reference to /@self@/. If the last reference is dropped,
-- the instance is freed and all associate data released.
-- 
-- Since 1.42, ref-counting of t'GI.NM.Structs.WireGuardPeer.WireGuardPeer' is thread-safe.
-- 
-- /Since: 1.16/
wireGuardPeerUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Maybe (WireGuardPeer)
    -- ^ /@self@/: the t'GI.NM.Structs.WireGuardPeer.WireGuardPeer' instance
    -> m ()
wireGuardPeerUnref :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Maybe WireGuardPeer -> m ()
wireGuardPeerUnref Maybe WireGuardPeer
self = 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 WireGuardPeer
maybeSelf <- case Maybe WireGuardPeer
self of
        Maybe WireGuardPeer
Nothing -> Ptr WireGuardPeer -> IO (Ptr WireGuardPeer)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr WireGuardPeer
forall a. Ptr a
FP.nullPtr
        Just WireGuardPeer
jSelf -> do
            Ptr WireGuardPeer
jSelf' <- WireGuardPeer -> IO (Ptr WireGuardPeer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr WireGuardPeer
jSelf
            Ptr WireGuardPeer -> IO (Ptr WireGuardPeer)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr WireGuardPeer
jSelf'
    Ptr WireGuardPeer -> IO ()
nm_wireguard_peer_unref Ptr WireGuardPeer
maybeSelf
    Maybe WireGuardPeer -> (WireGuardPeer -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe WireGuardPeer
self WireGuardPeer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data WireGuardPeerUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod WireGuardPeerUnrefMethodInfo WireGuardPeer signature where
    overloadedMethod i = wireGuardPeerUnref (Just i)

instance O.OverloadedMethodInfo WireGuardPeerUnrefMethodInfo WireGuardPeer where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.WireGuardPeer.wireGuardPeerUnref",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-WireGuardPeer.html#v:wireGuardPeerUnref"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveWireGuardPeerMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveWireGuardPeerMethod "appendAllowedIp" o = WireGuardPeerAppendAllowedIpMethodInfo
    ResolveWireGuardPeerMethod "clearAllowedIps" o = WireGuardPeerClearAllowedIpsMethodInfo
    ResolveWireGuardPeerMethod "cmp" o = WireGuardPeerCmpMethodInfo
    ResolveWireGuardPeerMethod "isSealed" o = WireGuardPeerIsSealedMethodInfo
    ResolveWireGuardPeerMethod "isValid" o = WireGuardPeerIsValidMethodInfo
    ResolveWireGuardPeerMethod "newClone" o = WireGuardPeerNewCloneMethodInfo
    ResolveWireGuardPeerMethod "ref" o = WireGuardPeerRefMethodInfo
    ResolveWireGuardPeerMethod "removeAllowedIp" o = WireGuardPeerRemoveAllowedIpMethodInfo
    ResolveWireGuardPeerMethod "seal" o = WireGuardPeerSealMethodInfo
    ResolveWireGuardPeerMethod "unref" o = WireGuardPeerUnrefMethodInfo
    ResolveWireGuardPeerMethod "getAllowedIp" o = WireGuardPeerGetAllowedIpMethodInfo
    ResolveWireGuardPeerMethod "getAllowedIpsLen" o = WireGuardPeerGetAllowedIpsLenMethodInfo
    ResolveWireGuardPeerMethod "getEndpoint" o = WireGuardPeerGetEndpointMethodInfo
    ResolveWireGuardPeerMethod "getPersistentKeepalive" o = WireGuardPeerGetPersistentKeepaliveMethodInfo
    ResolveWireGuardPeerMethod "getPresharedKey" o = WireGuardPeerGetPresharedKeyMethodInfo
    ResolveWireGuardPeerMethod "getPresharedKeyFlags" o = WireGuardPeerGetPresharedKeyFlagsMethodInfo
    ResolveWireGuardPeerMethod "getPublicKey" o = WireGuardPeerGetPublicKeyMethodInfo
    ResolveWireGuardPeerMethod "setEndpoint" o = WireGuardPeerSetEndpointMethodInfo
    ResolveWireGuardPeerMethod "setPersistentKeepalive" o = WireGuardPeerSetPersistentKeepaliveMethodInfo
    ResolveWireGuardPeerMethod "setPresharedKey" o = WireGuardPeerSetPresharedKeyMethodInfo
    ResolveWireGuardPeerMethod "setPresharedKeyFlags" o = WireGuardPeerSetPresharedKeyFlagsMethodInfo
    ResolveWireGuardPeerMethod "setPublicKey" o = WireGuardPeerSetPublicKeyMethodInfo
    ResolveWireGuardPeerMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif