{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.Gio.Interfaces.DtlsClientConnection.DtlsClientConnection' is the client-side subclass of
-- t'GI.Gio.Interfaces.DtlsConnection.DtlsConnection', representing a client-side DTLS connection.
-- 
-- /Since: 2.48/

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

module GI.Gio.Interfaces.DtlsClientConnection
    ( 

-- * Exported types
    DtlsClientConnection(..)                ,
    IsDtlsClientConnection                  ,
    toDtlsClientConnection                  ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveDtlsClientConnectionMethod       ,
#endif


-- ** getAcceptedCas #method:getAcceptedCas#

#if defined(ENABLE_OVERLOADING)
    DtlsClientConnectionGetAcceptedCasMethodInfo,
#endif
    dtlsClientConnectionGetAcceptedCas      ,


-- ** getServerIdentity #method:getServerIdentity#

#if defined(ENABLE_OVERLOADING)
    DtlsClientConnectionGetServerIdentityMethodInfo,
#endif
    dtlsClientConnectionGetServerIdentity   ,


-- ** getValidationFlags #method:getValidationFlags#

#if defined(ENABLE_OVERLOADING)
    DtlsClientConnectionGetValidationFlagsMethodInfo,
#endif
    dtlsClientConnectionGetValidationFlags  ,


-- ** new #method:new#

    dtlsClientConnectionNew                 ,


-- ** setServerIdentity #method:setServerIdentity#

#if defined(ENABLE_OVERLOADING)
    DtlsClientConnectionSetServerIdentityMethodInfo,
#endif
    dtlsClientConnectionSetServerIdentity   ,


-- ** setValidationFlags #method:setValidationFlags#

#if defined(ENABLE_OVERLOADING)
    DtlsClientConnectionSetValidationFlagsMethodInfo,
#endif
    dtlsClientConnectionSetValidationFlags  ,




 -- * Properties
-- ** acceptedCas #attr:acceptedCas#
-- | A list of the distinguished names of the Certificate Authorities
-- that the server will accept client certificates signed by. If the
-- server requests a client certificate during the handshake, then
-- this property will be set after the handshake completes.
-- 
-- Each item in the list is a t'GI.GLib.Structs.ByteArray.ByteArray' which contains the complete
-- subject DN of the certificate authority.
-- 
-- /Since: 2.48/

#if defined(ENABLE_OVERLOADING)
    DtlsClientConnectionAcceptedCasPropertyInfo,
#endif
#if defined(ENABLE_OVERLOADING)
    dtlsClientConnectionAcceptedCas         ,
#endif
    getDtlsClientConnectionAcceptedCas      ,


-- ** serverIdentity #attr:serverIdentity#
-- | A t'GI.Gio.Interfaces.SocketConnectable.SocketConnectable' describing the identity of the server that
-- is expected on the other end of the connection.
-- 
-- If the 'GI.Gio.Flags.TlsCertificateFlagsBadIdentity' flag is set in
-- t'GI.Gio.Interfaces.DtlsClientConnection.DtlsClientConnection':@/validation-flags/@, this object will be used
-- to determine the expected identify of the remote end of the
-- connection; if t'GI.Gio.Interfaces.DtlsClientConnection.DtlsClientConnection':@/server-identity/@ is not set,
-- or does not match the identity presented by the server, then the
-- 'GI.Gio.Flags.TlsCertificateFlagsBadIdentity' validation will fail.
-- 
-- In addition to its use in verifying the server certificate,
-- this is also used to give a hint to the server about what
-- certificate we expect, which is useful for servers that serve
-- virtual hosts.
-- 
-- /Since: 2.48/

#if defined(ENABLE_OVERLOADING)
    DtlsClientConnectionServerIdentityPropertyInfo,
#endif
    constructDtlsClientConnectionServerIdentity,
#if defined(ENABLE_OVERLOADING)
    dtlsClientConnectionServerIdentity      ,
#endif
    getDtlsClientConnectionServerIdentity   ,
    setDtlsClientConnectionServerIdentity   ,


-- ** validationFlags #attr:validationFlags#
-- | What steps to perform when validating a certificate received from
-- a server. Server certificates that fail to validate in all of the
-- ways indicated here will be rejected unless the application
-- overrides the default via [acceptCertificate]("GI.Gio.Interfaces.DtlsConnection#g:signal:acceptCertificate").
-- 
-- /Since: 2.48/

#if defined(ENABLE_OVERLOADING)
    DtlsClientConnectionValidationFlagsPropertyInfo,
#endif
    constructDtlsClientConnectionValidationFlags,
#if defined(ENABLE_OVERLOADING)
    dtlsClientConnectionValidationFlags     ,
#endif
    getDtlsClientConnectionValidationFlags  ,
    setDtlsClientConnectionValidationFlags  ,




    ) 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.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
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.Text as T
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 GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gio.Flags as Gio.Flags
import {-# SOURCE #-} qualified GI.Gio.Interfaces.DatagramBased as Gio.DatagramBased
import {-# SOURCE #-} qualified GI.Gio.Interfaces.DtlsConnection as Gio.DtlsConnection
import {-# SOURCE #-} qualified GI.Gio.Interfaces.SocketConnectable as Gio.SocketConnectable

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

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

foreign import ccall "g_dtls_client_connection_get_type"
    c_g_dtls_client_connection_get_type :: IO B.Types.GType

instance B.Types.TypedObject DtlsClientConnection where
    glibType :: IO GType
glibType = IO GType
c_g_dtls_client_connection_get_type

instance B.Types.GObject DtlsClientConnection

-- | Convert 'DtlsClientConnection' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue DtlsClientConnection where
    toGValue :: DtlsClientConnection -> IO GValue
toGValue DtlsClientConnection
o = do
        GType
gtype <- IO GType
c_g_dtls_client_connection_get_type
        DtlsClientConnection
-> (Ptr DtlsClientConnection -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr DtlsClientConnection
o (GType
-> (GValue -> Ptr DtlsClientConnection -> IO ())
-> Ptr DtlsClientConnection
-> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr DtlsClientConnection -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO DtlsClientConnection
fromGValue GValue
gv = do
        Ptr DtlsClientConnection
ptr <- GValue -> IO (Ptr DtlsClientConnection)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr DtlsClientConnection)
        (ManagedPtr DtlsClientConnection -> DtlsClientConnection)
-> Ptr DtlsClientConnection -> IO DtlsClientConnection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr DtlsClientConnection -> DtlsClientConnection
DtlsClientConnection Ptr DtlsClientConnection
ptr
        
    

-- | Type class for types which can be safely cast to `DtlsClientConnection`, for instance with `toDtlsClientConnection`.
class (SP.GObject o, O.IsDescendantOf DtlsClientConnection o) => IsDtlsClientConnection o
instance (SP.GObject o, O.IsDescendantOf DtlsClientConnection o) => IsDtlsClientConnection o

instance O.HasParentTypes DtlsClientConnection
type instance O.ParentTypes DtlsClientConnection = '[Gio.DatagramBased.DatagramBased, Gio.DtlsConnection.DtlsConnection, GObject.Object.Object]

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

-- VVV Prop "accepted-cas"
   -- Type: TGList (TBasicType TPtr)
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@accepted-cas@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dtlsClientConnection #acceptedCas
-- @
getDtlsClientConnectionAcceptedCas :: (MonadIO m, IsDtlsClientConnection o) => o -> m ([Ptr ()])
getDtlsClientConnectionAcceptedCas :: o -> m [Ptr ()]
getDtlsClientConnectionAcceptedCas o
obj = IO [Ptr ()] -> m [Ptr ()]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Ptr ()] -> m [Ptr ()]) -> IO [Ptr ()] -> m [Ptr ()]
forall a b. (a -> b) -> a -> b
$ o -> String -> IO [Ptr ()]
forall a b. GObject a => a -> String -> IO [Ptr b]
B.Properties.getObjectPropertyPtrGList o
obj String
"accepted-cas"

#if defined(ENABLE_OVERLOADING)
data DtlsClientConnectionAcceptedCasPropertyInfo
instance AttrInfo DtlsClientConnectionAcceptedCasPropertyInfo where
    type AttrAllowedOps DtlsClientConnectionAcceptedCasPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint DtlsClientConnectionAcceptedCasPropertyInfo = IsDtlsClientConnection
    type AttrSetTypeConstraint DtlsClientConnectionAcceptedCasPropertyInfo = (~) ()
    type AttrTransferTypeConstraint DtlsClientConnectionAcceptedCasPropertyInfo = (~) ()
    type AttrTransferType DtlsClientConnectionAcceptedCasPropertyInfo = ()
    type AttrGetType DtlsClientConnectionAcceptedCasPropertyInfo = ([Ptr ()])
    type AttrLabel DtlsClientConnectionAcceptedCasPropertyInfo = "accepted-cas"
    type AttrOrigin DtlsClientConnectionAcceptedCasPropertyInfo = DtlsClientConnection
    attrGet = getDtlsClientConnectionAcceptedCas
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

-- VVV Prop "server-identity"
   -- Type: TInterface (Name {namespace = "Gio", name = "SocketConnectable"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@server-identity@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dtlsClientConnection #serverIdentity
-- @
getDtlsClientConnectionServerIdentity :: (MonadIO m, IsDtlsClientConnection o) => o -> m Gio.SocketConnectable.SocketConnectable
getDtlsClientConnectionServerIdentity :: o -> m SocketConnectable
getDtlsClientConnectionServerIdentity o
obj = IO SocketConnectable -> m SocketConnectable
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SocketConnectable -> m SocketConnectable)
-> IO SocketConnectable -> m SocketConnectable
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe SocketConnectable) -> IO SocketConnectable
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getDtlsClientConnectionServerIdentity" (IO (Maybe SocketConnectable) -> IO SocketConnectable)
-> IO (Maybe SocketConnectable) -> IO SocketConnectable
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr SocketConnectable -> SocketConnectable)
-> IO (Maybe SocketConnectable)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"server-identity" ManagedPtr SocketConnectable -> SocketConnectable
Gio.SocketConnectable.SocketConnectable

-- | Set the value of the “@server-identity@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' dtlsClientConnection [ #serverIdentity 'Data.GI.Base.Attributes.:=' value ]
-- @
setDtlsClientConnectionServerIdentity :: (MonadIO m, IsDtlsClientConnection o, Gio.SocketConnectable.IsSocketConnectable a) => o -> a -> m ()
setDtlsClientConnectionServerIdentity :: o -> a -> m ()
setDtlsClientConnectionServerIdentity o
obj a
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"server-identity" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `GValueConstruct` with valid value for the “@server-identity@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDtlsClientConnectionServerIdentity :: (IsDtlsClientConnection o, MIO.MonadIO m, Gio.SocketConnectable.IsSocketConnectable a) => a -> m (GValueConstruct o)
constructDtlsClientConnectionServerIdentity :: a -> m (GValueConstruct o)
constructDtlsClientConnectionServerIdentity a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"server-identity" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

#if defined(ENABLE_OVERLOADING)
data DtlsClientConnectionServerIdentityPropertyInfo
instance AttrInfo DtlsClientConnectionServerIdentityPropertyInfo where
    type AttrAllowedOps DtlsClientConnectionServerIdentityPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DtlsClientConnectionServerIdentityPropertyInfo = IsDtlsClientConnection
    type AttrSetTypeConstraint DtlsClientConnectionServerIdentityPropertyInfo = Gio.SocketConnectable.IsSocketConnectable
    type AttrTransferTypeConstraint DtlsClientConnectionServerIdentityPropertyInfo = Gio.SocketConnectable.IsSocketConnectable
    type AttrTransferType DtlsClientConnectionServerIdentityPropertyInfo = Gio.SocketConnectable.SocketConnectable
    type AttrGetType DtlsClientConnectionServerIdentityPropertyInfo = Gio.SocketConnectable.SocketConnectable
    type AttrLabel DtlsClientConnectionServerIdentityPropertyInfo = "server-identity"
    type AttrOrigin DtlsClientConnectionServerIdentityPropertyInfo = DtlsClientConnection
    attrGet = getDtlsClientConnectionServerIdentity
    attrSet = setDtlsClientConnectionServerIdentity
    attrTransfer _ v = do
        unsafeCastTo Gio.SocketConnectable.SocketConnectable v
    attrConstruct = constructDtlsClientConnectionServerIdentity
    attrClear = undefined
#endif

-- VVV Prop "validation-flags"
   -- Type: TInterface (Name {namespace = "Gio", name = "TlsCertificateFlags"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@validation-flags@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dtlsClientConnection #validationFlags
-- @
getDtlsClientConnectionValidationFlags :: (MonadIO m, IsDtlsClientConnection o) => o -> m [Gio.Flags.TlsCertificateFlags]
getDtlsClientConnectionValidationFlags :: o -> m [TlsCertificateFlags]
getDtlsClientConnectionValidationFlags o
obj = IO [TlsCertificateFlags] -> m [TlsCertificateFlags]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [TlsCertificateFlags] -> m [TlsCertificateFlags])
-> IO [TlsCertificateFlags] -> m [TlsCertificateFlags]
forall a b. (a -> b) -> a -> b
$ o -> String -> IO [TlsCertificateFlags]
forall a b.
(GObject a, IsGFlag b, BoxedFlags b) =>
a -> String -> IO [b]
B.Properties.getObjectPropertyFlags o
obj String
"validation-flags"

-- | Set the value of the “@validation-flags@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' dtlsClientConnection [ #validationFlags 'Data.GI.Base.Attributes.:=' value ]
-- @
setDtlsClientConnectionValidationFlags :: (MonadIO m, IsDtlsClientConnection o) => o -> [Gio.Flags.TlsCertificateFlags] -> m ()
setDtlsClientConnectionValidationFlags :: o -> [TlsCertificateFlags] -> m ()
setDtlsClientConnectionValidationFlags o
obj [TlsCertificateFlags]
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> [TlsCertificateFlags] -> IO ()
forall a b.
(IsGFlag b, BoxedFlags b, GObject a) =>
a -> String -> [b] -> IO ()
B.Properties.setObjectPropertyFlags o
obj String
"validation-flags" [TlsCertificateFlags]
val

-- | Construct a `GValueConstruct` with valid value for the “@validation-flags@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDtlsClientConnectionValidationFlags :: (IsDtlsClientConnection o, MIO.MonadIO m) => [Gio.Flags.TlsCertificateFlags] -> m (GValueConstruct o)
constructDtlsClientConnectionValidationFlags :: [TlsCertificateFlags] -> m (GValueConstruct o)
constructDtlsClientConnectionValidationFlags [TlsCertificateFlags]
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> [TlsCertificateFlags] -> IO (GValueConstruct o)
forall a o.
(IsGFlag a, BoxedFlags a) =>
String -> [a] -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyFlags String
"validation-flags" [TlsCertificateFlags]
val

#if defined(ENABLE_OVERLOADING)
data DtlsClientConnectionValidationFlagsPropertyInfo
instance AttrInfo DtlsClientConnectionValidationFlagsPropertyInfo where
    type AttrAllowedOps DtlsClientConnectionValidationFlagsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DtlsClientConnectionValidationFlagsPropertyInfo = IsDtlsClientConnection
    type AttrSetTypeConstraint DtlsClientConnectionValidationFlagsPropertyInfo = (~) [Gio.Flags.TlsCertificateFlags]
    type AttrTransferTypeConstraint DtlsClientConnectionValidationFlagsPropertyInfo = (~) [Gio.Flags.TlsCertificateFlags]
    type AttrTransferType DtlsClientConnectionValidationFlagsPropertyInfo = [Gio.Flags.TlsCertificateFlags]
    type AttrGetType DtlsClientConnectionValidationFlagsPropertyInfo = [Gio.Flags.TlsCertificateFlags]
    type AttrLabel DtlsClientConnectionValidationFlagsPropertyInfo = "validation-flags"
    type AttrOrigin DtlsClientConnectionValidationFlagsPropertyInfo = DtlsClientConnection
    attrGet = getDtlsClientConnectionValidationFlags
    attrSet = setDtlsClientConnectionValidationFlags
    attrTransfer _ v = do
        return v
    attrConstruct = constructDtlsClientConnectionValidationFlags
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList DtlsClientConnection
type instance O.AttributeList DtlsClientConnection = DtlsClientConnectionAttributeList
type DtlsClientConnectionAttributeList = ('[ '("acceptedCas", DtlsClientConnectionAcceptedCasPropertyInfo), '("advertisedProtocols", Gio.DtlsConnection.DtlsConnectionAdvertisedProtocolsPropertyInfo), '("baseSocket", Gio.DtlsConnection.DtlsConnectionBaseSocketPropertyInfo), '("certificate", Gio.DtlsConnection.DtlsConnectionCertificatePropertyInfo), '("database", Gio.DtlsConnection.DtlsConnectionDatabasePropertyInfo), '("interaction", Gio.DtlsConnection.DtlsConnectionInteractionPropertyInfo), '("negotiatedProtocol", Gio.DtlsConnection.DtlsConnectionNegotiatedProtocolPropertyInfo), '("peerCertificate", Gio.DtlsConnection.DtlsConnectionPeerCertificatePropertyInfo), '("peerCertificateErrors", Gio.DtlsConnection.DtlsConnectionPeerCertificateErrorsPropertyInfo), '("rehandshakeMode", Gio.DtlsConnection.DtlsConnectionRehandshakeModePropertyInfo), '("requireCloseNotify", Gio.DtlsConnection.DtlsConnectionRequireCloseNotifyPropertyInfo), '("serverIdentity", DtlsClientConnectionServerIdentityPropertyInfo), '("validationFlags", DtlsClientConnectionValidationFlagsPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
dtlsClientConnectionAcceptedCas :: AttrLabelProxy "acceptedCas"
dtlsClientConnectionAcceptedCas = AttrLabelProxy

dtlsClientConnectionServerIdentity :: AttrLabelProxy "serverIdentity"
dtlsClientConnectionServerIdentity = AttrLabelProxy

dtlsClientConnectionValidationFlags :: AttrLabelProxy "validationFlags"
dtlsClientConnectionValidationFlags = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveDtlsClientConnectionMethod (t :: Symbol) (o :: *) :: * where
    ResolveDtlsClientConnectionMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveDtlsClientConnectionMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveDtlsClientConnectionMethod "close" o = Gio.DtlsConnection.DtlsConnectionCloseMethodInfo
    ResolveDtlsClientConnectionMethod "closeAsync" o = Gio.DtlsConnection.DtlsConnectionCloseAsyncMethodInfo
    ResolveDtlsClientConnectionMethod "closeFinish" o = Gio.DtlsConnection.DtlsConnectionCloseFinishMethodInfo
    ResolveDtlsClientConnectionMethod "conditionCheck" o = Gio.DatagramBased.DatagramBasedConditionCheckMethodInfo
    ResolveDtlsClientConnectionMethod "conditionWait" o = Gio.DatagramBased.DatagramBasedConditionWaitMethodInfo
    ResolveDtlsClientConnectionMethod "createSource" o = Gio.DatagramBased.DatagramBasedCreateSourceMethodInfo
    ResolveDtlsClientConnectionMethod "emitAcceptCertificate" o = Gio.DtlsConnection.DtlsConnectionEmitAcceptCertificateMethodInfo
    ResolveDtlsClientConnectionMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveDtlsClientConnectionMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveDtlsClientConnectionMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveDtlsClientConnectionMethod "handshake" o = Gio.DtlsConnection.DtlsConnectionHandshakeMethodInfo
    ResolveDtlsClientConnectionMethod "handshakeAsync" o = Gio.DtlsConnection.DtlsConnectionHandshakeAsyncMethodInfo
    ResolveDtlsClientConnectionMethod "handshakeFinish" o = Gio.DtlsConnection.DtlsConnectionHandshakeFinishMethodInfo
    ResolveDtlsClientConnectionMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveDtlsClientConnectionMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveDtlsClientConnectionMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveDtlsClientConnectionMethod "receiveMessages" o = Gio.DatagramBased.DatagramBasedReceiveMessagesMethodInfo
    ResolveDtlsClientConnectionMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveDtlsClientConnectionMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveDtlsClientConnectionMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveDtlsClientConnectionMethod "sendMessages" o = Gio.DatagramBased.DatagramBasedSendMessagesMethodInfo
    ResolveDtlsClientConnectionMethod "shutdown" o = Gio.DtlsConnection.DtlsConnectionShutdownMethodInfo
    ResolveDtlsClientConnectionMethod "shutdownAsync" o = Gio.DtlsConnection.DtlsConnectionShutdownAsyncMethodInfo
    ResolveDtlsClientConnectionMethod "shutdownFinish" o = Gio.DtlsConnection.DtlsConnectionShutdownFinishMethodInfo
    ResolveDtlsClientConnectionMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveDtlsClientConnectionMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveDtlsClientConnectionMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveDtlsClientConnectionMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveDtlsClientConnectionMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveDtlsClientConnectionMethod "getAcceptedCas" o = DtlsClientConnectionGetAcceptedCasMethodInfo
    ResolveDtlsClientConnectionMethod "getCertificate" o = Gio.DtlsConnection.DtlsConnectionGetCertificateMethodInfo
    ResolveDtlsClientConnectionMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveDtlsClientConnectionMethod "getDatabase" o = Gio.DtlsConnection.DtlsConnectionGetDatabaseMethodInfo
    ResolveDtlsClientConnectionMethod "getInteraction" o = Gio.DtlsConnection.DtlsConnectionGetInteractionMethodInfo
    ResolveDtlsClientConnectionMethod "getNegotiatedProtocol" o = Gio.DtlsConnection.DtlsConnectionGetNegotiatedProtocolMethodInfo
    ResolveDtlsClientConnectionMethod "getPeerCertificate" o = Gio.DtlsConnection.DtlsConnectionGetPeerCertificateMethodInfo
    ResolveDtlsClientConnectionMethod "getPeerCertificateErrors" o = Gio.DtlsConnection.DtlsConnectionGetPeerCertificateErrorsMethodInfo
    ResolveDtlsClientConnectionMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveDtlsClientConnectionMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveDtlsClientConnectionMethod "getRehandshakeMode" o = Gio.DtlsConnection.DtlsConnectionGetRehandshakeModeMethodInfo
    ResolveDtlsClientConnectionMethod "getRequireCloseNotify" o = Gio.DtlsConnection.DtlsConnectionGetRequireCloseNotifyMethodInfo
    ResolveDtlsClientConnectionMethod "getServerIdentity" o = DtlsClientConnectionGetServerIdentityMethodInfo
    ResolveDtlsClientConnectionMethod "getValidationFlags" o = DtlsClientConnectionGetValidationFlagsMethodInfo
    ResolveDtlsClientConnectionMethod "setAdvertisedProtocols" o = Gio.DtlsConnection.DtlsConnectionSetAdvertisedProtocolsMethodInfo
    ResolveDtlsClientConnectionMethod "setCertificate" o = Gio.DtlsConnection.DtlsConnectionSetCertificateMethodInfo
    ResolveDtlsClientConnectionMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveDtlsClientConnectionMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveDtlsClientConnectionMethod "setDatabase" o = Gio.DtlsConnection.DtlsConnectionSetDatabaseMethodInfo
    ResolveDtlsClientConnectionMethod "setInteraction" o = Gio.DtlsConnection.DtlsConnectionSetInteractionMethodInfo
    ResolveDtlsClientConnectionMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveDtlsClientConnectionMethod "setRehandshakeMode" o = Gio.DtlsConnection.DtlsConnectionSetRehandshakeModeMethodInfo
    ResolveDtlsClientConnectionMethod "setRequireCloseNotify" o = Gio.DtlsConnection.DtlsConnectionSetRequireCloseNotifyMethodInfo
    ResolveDtlsClientConnectionMethod "setServerIdentity" o = DtlsClientConnectionSetServerIdentityMethodInfo
    ResolveDtlsClientConnectionMethod "setValidationFlags" o = DtlsClientConnectionSetValidationFlagsMethodInfo
    ResolveDtlsClientConnectionMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveDtlsClientConnectionMethod t DtlsClientConnection, O.MethodInfo info DtlsClientConnection p) => OL.IsLabel t (DtlsClientConnection -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#endif

-- method DtlsClientConnection::get_accepted_cas
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "conn"
--           , argType =
--               TInterface
--                 Name { namespace = "Gio" , name = "DtlsClientConnection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GDtlsClientConnection"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TGList TByteArray)
-- throws : False
-- Skip return : False

foreign import ccall "g_dtls_client_connection_get_accepted_cas" g_dtls_client_connection_get_accepted_cas :: 
    Ptr DtlsClientConnection ->             -- conn : TInterface (Name {namespace = "Gio", name = "DtlsClientConnection"})
    IO (Ptr (GList (Ptr GByteArray)))

-- | Gets the list of distinguished names of the Certificate Authorities
-- that the server will accept certificates from. This will be set
-- during the TLS handshake if the server requests a certificate.
-- Otherwise, it will be 'P.Nothing'.
-- 
-- Each item in the list is a t'GI.GLib.Structs.ByteArray.ByteArray' which contains the complete
-- subject DN of the certificate authority.
-- 
-- /Since: 2.48/
dtlsClientConnectionGetAcceptedCas ::
    (B.CallStack.HasCallStack, MonadIO m, IsDtlsClientConnection a) =>
    a
    -- ^ /@conn@/: the t'GI.Gio.Interfaces.DtlsClientConnection.DtlsClientConnection'
    -> m [ByteString]
    -- ^ __Returns:__ the list of
    -- CA DNs. You should unref each element with 'GI.GLib.Functions.byteArrayUnref' and then
    -- the free the list with @/g_list_free()/@.
dtlsClientConnectionGetAcceptedCas :: a -> m [ByteString]
dtlsClientConnectionGetAcceptedCas a
conn = IO [ByteString] -> m [ByteString]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ByteString] -> m [ByteString])
-> IO [ByteString] -> m [ByteString]
forall a b. (a -> b) -> a -> b
$ do
    Ptr DtlsClientConnection
conn' <- a -> IO (Ptr DtlsClientConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
conn
    Ptr (GList (Ptr GByteArray))
result <- Ptr DtlsClientConnection -> IO (Ptr (GList (Ptr GByteArray)))
g_dtls_client_connection_get_accepted_cas Ptr DtlsClientConnection
conn'
    [Ptr GByteArray]
result' <- Ptr (GList (Ptr GByteArray)) -> IO [Ptr GByteArray]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr GByteArray))
result
    [ByteString]
result'' <- (Ptr GByteArray -> IO ByteString)
-> [Ptr GByteArray] -> IO [ByteString]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Ptr GByteArray -> IO ByteString
unpackGByteArray [Ptr GByteArray]
result'
    (Ptr GByteArray -> IO ()) -> Ptr (GList (Ptr GByteArray)) -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (GList (Ptr a)) -> IO ()
mapGList Ptr GByteArray -> IO ()
unrefGByteArray Ptr (GList (Ptr GByteArray))
result
    Ptr (GList (Ptr GByteArray)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr GByteArray))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
conn
    [ByteString] -> IO [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return [ByteString]
result''

#if defined(ENABLE_OVERLOADING)
data DtlsClientConnectionGetAcceptedCasMethodInfo
instance (signature ~ (m [ByteString]), MonadIO m, IsDtlsClientConnection a) => O.MethodInfo DtlsClientConnectionGetAcceptedCasMethodInfo a signature where
    overloadedMethod = dtlsClientConnectionGetAcceptedCas

#endif

-- method DtlsClientConnection::get_server_identity
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "conn"
--           , argType =
--               TInterface
--                 Name { namespace = "Gio" , name = "DtlsClientConnection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GDtlsClientConnection"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Gio" , name = "SocketConnectable" })
-- throws : False
-- Skip return : False

foreign import ccall "g_dtls_client_connection_get_server_identity" g_dtls_client_connection_get_server_identity :: 
    Ptr DtlsClientConnection ->             -- conn : TInterface (Name {namespace = "Gio", name = "DtlsClientConnection"})
    IO (Ptr Gio.SocketConnectable.SocketConnectable)

-- | Gets /@conn@/\'s expected server identity
-- 
-- /Since: 2.48/
dtlsClientConnectionGetServerIdentity ::
    (B.CallStack.HasCallStack, MonadIO m, IsDtlsClientConnection a) =>
    a
    -- ^ /@conn@/: the t'GI.Gio.Interfaces.DtlsClientConnection.DtlsClientConnection'
    -> m Gio.SocketConnectable.SocketConnectable
    -- ^ __Returns:__ a t'GI.Gio.Interfaces.SocketConnectable.SocketConnectable' describing the
    -- expected server identity, or 'P.Nothing' if the expected identity is not
    -- known.
dtlsClientConnectionGetServerIdentity :: a -> m SocketConnectable
dtlsClientConnectionGetServerIdentity a
conn = IO SocketConnectable -> m SocketConnectable
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SocketConnectable -> m SocketConnectable)
-> IO SocketConnectable -> m SocketConnectable
forall a b. (a -> b) -> a -> b
$ do
    Ptr DtlsClientConnection
conn' <- a -> IO (Ptr DtlsClientConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
conn
    Ptr SocketConnectable
result <- Ptr DtlsClientConnection -> IO (Ptr SocketConnectable)
g_dtls_client_connection_get_server_identity Ptr DtlsClientConnection
conn'
    Text -> Ptr SocketConnectable -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dtlsClientConnectionGetServerIdentity" Ptr SocketConnectable
result
    SocketConnectable
result' <- ((ManagedPtr SocketConnectable -> SocketConnectable)
-> Ptr SocketConnectable -> IO SocketConnectable
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr SocketConnectable -> SocketConnectable
Gio.SocketConnectable.SocketConnectable) Ptr SocketConnectable
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
conn
    SocketConnectable -> IO SocketConnectable
forall (m :: * -> *) a. Monad m => a -> m a
return SocketConnectable
result'

#if defined(ENABLE_OVERLOADING)
data DtlsClientConnectionGetServerIdentityMethodInfo
instance (signature ~ (m Gio.SocketConnectable.SocketConnectable), MonadIO m, IsDtlsClientConnection a) => O.MethodInfo DtlsClientConnectionGetServerIdentityMethodInfo a signature where
    overloadedMethod = dtlsClientConnectionGetServerIdentity

#endif

-- method DtlsClientConnection::get_validation_flags
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "conn"
--           , argType =
--               TInterface
--                 Name { namespace = "Gio" , name = "DtlsClientConnection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GDtlsClientConnection"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Gio" , name = "TlsCertificateFlags" })
-- throws : False
-- Skip return : False

foreign import ccall "g_dtls_client_connection_get_validation_flags" g_dtls_client_connection_get_validation_flags :: 
    Ptr DtlsClientConnection ->             -- conn : TInterface (Name {namespace = "Gio", name = "DtlsClientConnection"})
    IO CUInt

-- | Gets /@conn@/\'s validation flags
-- 
-- /Since: 2.48/
dtlsClientConnectionGetValidationFlags ::
    (B.CallStack.HasCallStack, MonadIO m, IsDtlsClientConnection a) =>
    a
    -- ^ /@conn@/: the t'GI.Gio.Interfaces.DtlsClientConnection.DtlsClientConnection'
    -> m [Gio.Flags.TlsCertificateFlags]
    -- ^ __Returns:__ the validation flags
dtlsClientConnectionGetValidationFlags :: a -> m [TlsCertificateFlags]
dtlsClientConnectionGetValidationFlags a
conn = IO [TlsCertificateFlags] -> m [TlsCertificateFlags]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [TlsCertificateFlags] -> m [TlsCertificateFlags])
-> IO [TlsCertificateFlags] -> m [TlsCertificateFlags]
forall a b. (a -> b) -> a -> b
$ do
    Ptr DtlsClientConnection
conn' <- a -> IO (Ptr DtlsClientConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
conn
    CUInt
result <- Ptr DtlsClientConnection -> IO CUInt
g_dtls_client_connection_get_validation_flags Ptr DtlsClientConnection
conn'
    let result' :: [TlsCertificateFlags]
result' = CUInt -> [TlsCertificateFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
conn
    [TlsCertificateFlags] -> IO [TlsCertificateFlags]
forall (m :: * -> *) a. Monad m => a -> m a
return [TlsCertificateFlags]
result'

#if defined(ENABLE_OVERLOADING)
data DtlsClientConnectionGetValidationFlagsMethodInfo
instance (signature ~ (m [Gio.Flags.TlsCertificateFlags]), MonadIO m, IsDtlsClientConnection a) => O.MethodInfo DtlsClientConnectionGetValidationFlagsMethodInfo a signature where
    overloadedMethod = dtlsClientConnectionGetValidationFlags

#endif

-- method DtlsClientConnection::set_server_identity
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "conn"
--           , argType =
--               TInterface
--                 Name { namespace = "Gio" , name = "DtlsClientConnection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GDtlsClientConnection"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "identity"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SocketConnectable" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #GSocketConnectable describing the expected server identity"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_dtls_client_connection_set_server_identity" g_dtls_client_connection_set_server_identity :: 
    Ptr DtlsClientConnection ->             -- conn : TInterface (Name {namespace = "Gio", name = "DtlsClientConnection"})
    Ptr Gio.SocketConnectable.SocketConnectable -> -- identity : TInterface (Name {namespace = "Gio", name = "SocketConnectable"})
    IO ()

-- | Sets /@conn@/\'s expected server identity, which is used both to tell
-- servers on virtual hosts which certificate to present, and also
-- to let /@conn@/ know what name to look for in the certificate when
-- performing 'GI.Gio.Flags.TlsCertificateFlagsBadIdentity' validation, if enabled.
-- 
-- /Since: 2.48/
dtlsClientConnectionSetServerIdentity ::
    (B.CallStack.HasCallStack, MonadIO m, IsDtlsClientConnection a, Gio.SocketConnectable.IsSocketConnectable b) =>
    a
    -- ^ /@conn@/: the t'GI.Gio.Interfaces.DtlsClientConnection.DtlsClientConnection'
    -> b
    -- ^ /@identity@/: a t'GI.Gio.Interfaces.SocketConnectable.SocketConnectable' describing the expected server identity
    -> m ()
dtlsClientConnectionSetServerIdentity :: a -> b -> m ()
dtlsClientConnectionSetServerIdentity a
conn b
identity = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DtlsClientConnection
conn' <- a -> IO (Ptr DtlsClientConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
conn
    Ptr SocketConnectable
identity' <- b -> IO (Ptr SocketConnectable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
identity
    Ptr DtlsClientConnection -> Ptr SocketConnectable -> IO ()
g_dtls_client_connection_set_server_identity Ptr DtlsClientConnection
conn' Ptr SocketConnectable
identity'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
conn
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
identity
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DtlsClientConnectionSetServerIdentityMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsDtlsClientConnection a, Gio.SocketConnectable.IsSocketConnectable b) => O.MethodInfo DtlsClientConnectionSetServerIdentityMethodInfo a signature where
    overloadedMethod = dtlsClientConnectionSetServerIdentity

#endif

-- method DtlsClientConnection::set_validation_flags
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "conn"
--           , argType =
--               TInterface
--                 Name { namespace = "Gio" , name = "DtlsClientConnection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GDtlsClientConnection"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "Gio" , name = "TlsCertificateFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GTlsCertificateFlags to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_dtls_client_connection_set_validation_flags" g_dtls_client_connection_set_validation_flags :: 
    Ptr DtlsClientConnection ->             -- conn : TInterface (Name {namespace = "Gio", name = "DtlsClientConnection"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "TlsCertificateFlags"})
    IO ()

-- | Sets /@conn@/\'s validation flags, to override the default set of
-- checks performed when validating a server certificate. By default,
-- 'GI.Gio.Flags.TlsCertificateFlagsValidateAll' is used.
-- 
-- /Since: 2.48/
dtlsClientConnectionSetValidationFlags ::
    (B.CallStack.HasCallStack, MonadIO m, IsDtlsClientConnection a) =>
    a
    -- ^ /@conn@/: the t'GI.Gio.Interfaces.DtlsClientConnection.DtlsClientConnection'
    -> [Gio.Flags.TlsCertificateFlags]
    -- ^ /@flags@/: the t'GI.Gio.Flags.TlsCertificateFlags' to use
    -> m ()
dtlsClientConnectionSetValidationFlags :: a -> [TlsCertificateFlags] -> m ()
dtlsClientConnectionSetValidationFlags a
conn [TlsCertificateFlags]
flags = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DtlsClientConnection
conn' <- a -> IO (Ptr DtlsClientConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
conn
    let flags' :: CUInt
flags' = [TlsCertificateFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [TlsCertificateFlags]
flags
    Ptr DtlsClientConnection -> CUInt -> IO ()
g_dtls_client_connection_set_validation_flags Ptr DtlsClientConnection
conn' CUInt
flags'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
conn
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DtlsClientConnectionSetValidationFlagsMethodInfo
instance (signature ~ ([Gio.Flags.TlsCertificateFlags] -> m ()), MonadIO m, IsDtlsClientConnection a) => O.MethodInfo DtlsClientConnectionSetValidationFlagsMethodInfo a signature where
    overloadedMethod = dtlsClientConnectionSetValidationFlags

#endif

-- method DtlsClientConnection::new
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "base_socket"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DatagramBased" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GDatagramBased to wrap"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "server_identity"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SocketConnectable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the expected identity of the server"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Gio" , name = "DtlsClientConnection" })
-- throws : True
-- Skip return : False

foreign import ccall "g_dtls_client_connection_new" g_dtls_client_connection_new :: 
    Ptr Gio.DatagramBased.DatagramBased ->  -- base_socket : TInterface (Name {namespace = "Gio", name = "DatagramBased"})
    Ptr Gio.SocketConnectable.SocketConnectable -> -- server_identity : TInterface (Name {namespace = "Gio", name = "SocketConnectable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr DtlsClientConnection)

-- | Creates a new t'GI.Gio.Interfaces.DtlsClientConnection.DtlsClientConnection' wrapping /@baseSocket@/ which is
-- assumed to communicate with the server identified by /@serverIdentity@/.
-- 
-- /Since: 2.48/
dtlsClientConnectionNew ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.DatagramBased.IsDatagramBased a, Gio.SocketConnectable.IsSocketConnectable b) =>
    a
    -- ^ /@baseSocket@/: the t'GI.Gio.Interfaces.DatagramBased.DatagramBased' to wrap
    -> Maybe (b)
    -- ^ /@serverIdentity@/: the expected identity of the server
    -> m DtlsClientConnection
    -- ^ __Returns:__ the new
    --   t'GI.Gio.Interfaces.DtlsClientConnection.DtlsClientConnection', or 'P.Nothing' on error /(Can throw 'Data.GI.Base.GError.GError')/
dtlsClientConnectionNew :: a -> Maybe b -> m DtlsClientConnection
dtlsClientConnectionNew a
baseSocket Maybe b
serverIdentity = IO DtlsClientConnection -> m DtlsClientConnection
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DtlsClientConnection -> m DtlsClientConnection)
-> IO DtlsClientConnection -> m DtlsClientConnection
forall a b. (a -> b) -> a -> b
$ do
    Ptr DatagramBased
baseSocket' <- a -> IO (Ptr DatagramBased)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
baseSocket
    Ptr SocketConnectable
maybeServerIdentity <- case Maybe b
serverIdentity of
        Maybe b
Nothing -> Ptr SocketConnectable -> IO (Ptr SocketConnectable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr SocketConnectable
forall a. Ptr a
nullPtr
        Just b
jServerIdentity -> do
            Ptr SocketConnectable
jServerIdentity' <- b -> IO (Ptr SocketConnectable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jServerIdentity
            Ptr SocketConnectable -> IO (Ptr SocketConnectable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr SocketConnectable
jServerIdentity'
    IO DtlsClientConnection -> IO () -> IO DtlsClientConnection
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr DtlsClientConnection
result <- (Ptr (Ptr GError) -> IO (Ptr DtlsClientConnection))
-> IO (Ptr DtlsClientConnection)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr DtlsClientConnection))
 -> IO (Ptr DtlsClientConnection))
-> (Ptr (Ptr GError) -> IO (Ptr DtlsClientConnection))
-> IO (Ptr DtlsClientConnection)
forall a b. (a -> b) -> a -> b
$ Ptr DatagramBased
-> Ptr SocketConnectable
-> Ptr (Ptr GError)
-> IO (Ptr DtlsClientConnection)
g_dtls_client_connection_new Ptr DatagramBased
baseSocket' Ptr SocketConnectable
maybeServerIdentity
        Text -> Ptr DtlsClientConnection -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dtlsClientConnectionNew" Ptr DtlsClientConnection
result
        DtlsClientConnection
result' <- ((ManagedPtr DtlsClientConnection -> DtlsClientConnection)
-> Ptr DtlsClientConnection -> IO DtlsClientConnection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr DtlsClientConnection -> DtlsClientConnection
DtlsClientConnection) Ptr DtlsClientConnection
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
baseSocket
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
serverIdentity b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        DtlsClientConnection -> IO DtlsClientConnection
forall (m :: * -> *) a. Monad m => a -> m a
return DtlsClientConnection
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList DtlsClientConnection = DtlsClientConnectionSignalList
type DtlsClientConnectionSignalList = ('[ '("acceptCertificate", Gio.DtlsConnection.DtlsConnectionAcceptCertificateSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif