{-# LANGUAGE TypeApplications #-}
#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif
module GI.NM.Structs.WireGuardPeer
(
WireGuardPeer(..) ,
#if defined(ENABLE_OVERLOADING)
ResolveWireGuardPeerMethod ,
#endif
#if defined(ENABLE_OVERLOADING)
WireGuardPeerAppendAllowedIpMethodInfo ,
#endif
wireGuardPeerAppendAllowedIp ,
#if defined(ENABLE_OVERLOADING)
WireGuardPeerClearAllowedIpsMethodInfo ,
#endif
wireGuardPeerClearAllowedIps ,
#if defined(ENABLE_OVERLOADING)
WireGuardPeerCmpMethodInfo ,
#endif
wireGuardPeerCmp ,
#if defined(ENABLE_OVERLOADING)
WireGuardPeerGetAllowedIpMethodInfo ,
#endif
wireGuardPeerGetAllowedIp ,
#if defined(ENABLE_OVERLOADING)
WireGuardPeerGetAllowedIpsLenMethodInfo ,
#endif
wireGuardPeerGetAllowedIpsLen ,
#if defined(ENABLE_OVERLOADING)
WireGuardPeerGetEndpointMethodInfo ,
#endif
wireGuardPeerGetEndpoint ,
#if defined(ENABLE_OVERLOADING)
WireGuardPeerGetPersistentKeepaliveMethodInfo,
#endif
wireGuardPeerGetPersistentKeepalive ,
#if defined(ENABLE_OVERLOADING)
WireGuardPeerGetPresharedKeyMethodInfo ,
#endif
wireGuardPeerGetPresharedKey ,
#if defined(ENABLE_OVERLOADING)
WireGuardPeerGetPresharedKeyFlagsMethodInfo,
#endif
wireGuardPeerGetPresharedKeyFlags ,
#if defined(ENABLE_OVERLOADING)
WireGuardPeerGetPublicKeyMethodInfo ,
#endif
wireGuardPeerGetPublicKey ,
#if defined(ENABLE_OVERLOADING)
WireGuardPeerIsSealedMethodInfo ,
#endif
wireGuardPeerIsSealed ,
#if defined(ENABLE_OVERLOADING)
WireGuardPeerIsValidMethodInfo ,
#endif
wireGuardPeerIsValid ,
wireGuardPeerNew ,
#if defined(ENABLE_OVERLOADING)
WireGuardPeerNewCloneMethodInfo ,
#endif
wireGuardPeerNewClone ,
#if defined(ENABLE_OVERLOADING)
WireGuardPeerRefMethodInfo ,
#endif
wireGuardPeerRef ,
#if defined(ENABLE_OVERLOADING)
WireGuardPeerRemoveAllowedIpMethodInfo ,
#endif
wireGuardPeerRemoveAllowedIp ,
#if defined(ENABLE_OVERLOADING)
WireGuardPeerSealMethodInfo ,
#endif
wireGuardPeerSeal ,
#if defined(ENABLE_OVERLOADING)
WireGuardPeerSetEndpointMethodInfo ,
#endif
wireGuardPeerSetEndpoint ,
#if defined(ENABLE_OVERLOADING)
WireGuardPeerSetPersistentKeepaliveMethodInfo,
#endif
wireGuardPeerSetPersistentKeepalive ,
#if defined(ENABLE_OVERLOADING)
WireGuardPeerSetPresharedKeyMethodInfo ,
#endif
wireGuardPeerSetPresharedKey ,
#if defined(ENABLE_OVERLOADING)
WireGuardPeerSetPresharedKeyFlagsMethodInfo,
#endif
wireGuardPeerSetPresharedKeyFlags ,
#if defined(ENABLE_OVERLOADING)
WireGuardPeerSetPublicKeyMethodInfo ,
#endif
wireGuardPeerSetPublicKey ,
#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
#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
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
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
foreign import ccall "nm_wireguard_peer_new" nm_wireguard_peer_new ::
IO (Ptr WireGuardPeer)
wireGuardPeerNew ::
(B.CallStack.HasCallStack, MonadIO m) =>
m WireGuardPeer
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
foreign import ccall "nm_wireguard_peer_append_allowed_ip" nm_wireguard_peer_append_allowed_ip ::
Ptr WireGuardPeer ->
CString ->
CInt ->
IO CInt
wireGuardPeerAppendAllowedIp ::
(B.CallStack.HasCallStack, MonadIO m) =>
WireGuardPeer
-> T.Text
-> Bool
-> m Bool
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
foreign import ccall "nm_wireguard_peer_clear_allowed_ips" nm_wireguard_peer_clear_allowed_ips ::
Ptr WireGuardPeer ->
IO ()
wireGuardPeerClearAllowedIps ::
(B.CallStack.HasCallStack, MonadIO m) =>
WireGuardPeer
-> 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
foreign import ccall "nm_wireguard_peer_cmp" nm_wireguard_peer_cmp ::
Ptr WireGuardPeer ->
Ptr WireGuardPeer ->
CUInt ->
IO Int32
wireGuardPeerCmp ::
(B.CallStack.HasCallStack, MonadIO m) =>
Maybe (WireGuardPeer)
-> Maybe (WireGuardPeer)
-> NM.Enums.SettingCompareFlags
-> m Int32
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
foreign import ccall "nm_wireguard_peer_get_allowed_ip" nm_wireguard_peer_get_allowed_ip ::
Ptr WireGuardPeer ->
Word32 ->
CInt ->
IO CString
wireGuardPeerGetAllowedIp ::
(B.CallStack.HasCallStack, MonadIO m) =>
WireGuardPeer
-> Word32
-> Bool
-> m (Maybe T.Text)
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
foreign import ccall "nm_wireguard_peer_get_allowed_ips_len" nm_wireguard_peer_get_allowed_ips_len ::
Ptr WireGuardPeer ->
IO Word32
wireGuardPeerGetAllowedIpsLen ::
(B.CallStack.HasCallStack, MonadIO m) =>
WireGuardPeer
-> m Word32
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
foreign import ccall "nm_wireguard_peer_get_endpoint" nm_wireguard_peer_get_endpoint ::
Ptr WireGuardPeer ->
IO CString
wireGuardPeerGetEndpoint ::
(B.CallStack.HasCallStack, MonadIO m) =>
WireGuardPeer
-> m T.Text
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
foreign import ccall "nm_wireguard_peer_get_persistent_keepalive" nm_wireguard_peer_get_persistent_keepalive ::
Ptr WireGuardPeer ->
IO Word16
wireGuardPeerGetPersistentKeepalive ::
(B.CallStack.HasCallStack, MonadIO m) =>
WireGuardPeer
-> m Word16
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
foreign import ccall "nm_wireguard_peer_get_preshared_key" nm_wireguard_peer_get_preshared_key ::
Ptr WireGuardPeer ->
IO CString
wireGuardPeerGetPresharedKey ::
(B.CallStack.HasCallStack, MonadIO m) =>
WireGuardPeer
-> m T.Text
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
foreign import ccall "nm_wireguard_peer_get_preshared_key_flags" nm_wireguard_peer_get_preshared_key_flags ::
Ptr WireGuardPeer ->
IO CUInt
wireGuardPeerGetPresharedKeyFlags ::
(B.CallStack.HasCallStack, MonadIO m) =>
WireGuardPeer
-> m [NM.Flags.SettingSecretFlags]
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
foreign import ccall "nm_wireguard_peer_get_public_key" nm_wireguard_peer_get_public_key ::
Ptr WireGuardPeer ->
IO CString
wireGuardPeerGetPublicKey ::
(B.CallStack.HasCallStack, MonadIO m) =>
WireGuardPeer
-> m T.Text
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
foreign import ccall "nm_wireguard_peer_is_sealed" nm_wireguard_peer_is_sealed ::
Ptr WireGuardPeer ->
IO CInt
wireGuardPeerIsSealed ::
(B.CallStack.HasCallStack, MonadIO m) =>
WireGuardPeer
-> m Bool
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
foreign import ccall "nm_wireguard_peer_is_valid" nm_wireguard_peer_is_valid ::
Ptr WireGuardPeer ->
CInt ->
CInt ->
Ptr (Ptr GError) ->
IO CInt
wireGuardPeerIsValid ::
(B.CallStack.HasCallStack, MonadIO m) =>
WireGuardPeer
-> Bool
-> Bool
-> m ()
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
foreign import ccall "nm_wireguard_peer_new_clone" nm_wireguard_peer_new_clone ::
Ptr WireGuardPeer ->
CInt ->
IO (Ptr WireGuardPeer)
wireGuardPeerNewClone ::
(B.CallStack.HasCallStack, MonadIO m) =>
WireGuardPeer
-> Bool
-> m WireGuardPeer
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
foreign import ccall "nm_wireguard_peer_ref" nm_wireguard_peer_ref ::
Ptr WireGuardPeer ->
IO (Ptr WireGuardPeer)
wireGuardPeerRef ::
(B.CallStack.HasCallStack, MonadIO m) =>
Maybe (WireGuardPeer)
-> m WireGuardPeer
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
foreign import ccall "nm_wireguard_peer_remove_allowed_ip" nm_wireguard_peer_remove_allowed_ip ::
Ptr WireGuardPeer ->
Word32 ->
IO CInt
wireGuardPeerRemoveAllowedIp ::
(B.CallStack.HasCallStack, MonadIO m) =>
WireGuardPeer
-> Word32
-> m Bool
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
foreign import ccall "nm_wireguard_peer_seal" nm_wireguard_peer_seal ::
Ptr WireGuardPeer ->
IO ()
wireGuardPeerSeal ::
(B.CallStack.HasCallStack, MonadIO m) =>
WireGuardPeer
-> 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
foreign import ccall "nm_wireguard_peer_set_endpoint" nm_wireguard_peer_set_endpoint ::
Ptr WireGuardPeer ->
CString ->
CInt ->
IO CInt
wireGuardPeerSetEndpoint ::
(B.CallStack.HasCallStack, MonadIO m) =>
WireGuardPeer
-> T.Text
-> Bool
-> m Bool
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
foreign import ccall "nm_wireguard_peer_set_persistent_keepalive" nm_wireguard_peer_set_persistent_keepalive ::
Ptr WireGuardPeer ->
Word16 ->
IO ()
wireGuardPeerSetPersistentKeepalive ::
(B.CallStack.HasCallStack, MonadIO m) =>
WireGuardPeer
-> Word16
-> 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
foreign import ccall "nm_wireguard_peer_set_preshared_key" nm_wireguard_peer_set_preshared_key ::
Ptr WireGuardPeer ->
CString ->
CInt ->
IO CInt
wireGuardPeerSetPresharedKey ::
(B.CallStack.HasCallStack, MonadIO m) =>
WireGuardPeer
-> Maybe (T.Text)
-> Bool
-> m Bool
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
foreign import ccall "nm_wireguard_peer_set_preshared_key_flags" nm_wireguard_peer_set_preshared_key_flags ::
Ptr WireGuardPeer ->
CUInt ->
IO ()
wireGuardPeerSetPresharedKeyFlags ::
(B.CallStack.HasCallStack, MonadIO m) =>
WireGuardPeer
-> [NM.Flags.SettingSecretFlags]
-> 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
foreign import ccall "nm_wireguard_peer_set_public_key" nm_wireguard_peer_set_public_key ::
Ptr WireGuardPeer ->
CString ->
CInt ->
IO CInt
wireGuardPeerSetPublicKey ::
(B.CallStack.HasCallStack, MonadIO m) =>
WireGuardPeer
-> Maybe (T.Text)
-> Bool
-> m Bool
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
foreign import ccall "nm_wireguard_peer_unref" nm_wireguard_peer_unref ::
Ptr WireGuardPeer ->
IO ()
wireGuardPeerUnref ::
(B.CallStack.HasCallStack, MonadIO m) =>
Maybe (WireGuardPeer)
-> 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