{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.Gio.Interfaces.TlsServerConnection.TlsServerConnection' is the server-side subclass of t'GI.Gio.Objects.TlsConnection.TlsConnection',
-- representing a server-side TLS connection.
-- 
-- /Since: 2.28/

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

module GI.Gio.Interfaces.TlsServerConnection
    ( 

-- * Exported types
    TlsServerConnection(..)                 ,
    IsTlsServerConnection                   ,
    toTlsServerConnection                   ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [clearPending]("GI.Gio.Objects.IOStream#g:method:clearPending"), [close]("GI.Gio.Objects.IOStream#g:method:close"), [closeAsync]("GI.Gio.Objects.IOStream#g:method:closeAsync"), [closeFinish]("GI.Gio.Objects.IOStream#g:method:closeFinish"), [emitAcceptCertificate]("GI.Gio.Objects.TlsConnection#g:method:emitAcceptCertificate"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [handshake]("GI.Gio.Objects.TlsConnection#g:method:handshake"), [handshakeAsync]("GI.Gio.Objects.TlsConnection#g:method:handshakeAsync"), [handshakeFinish]("GI.Gio.Objects.TlsConnection#g:method:handshakeFinish"), [hasPending]("GI.Gio.Objects.IOStream#g:method:hasPending"), [isClosed]("GI.Gio.Objects.IOStream#g:method:isClosed"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [spliceAsync]("GI.Gio.Objects.IOStream#g:method:spliceAsync"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getCertificate]("GI.Gio.Objects.TlsConnection#g:method:getCertificate"), [getChannelBindingData]("GI.Gio.Objects.TlsConnection#g:method:getChannelBindingData"), [getCiphersuiteName]("GI.Gio.Objects.TlsConnection#g:method:getCiphersuiteName"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDatabase]("GI.Gio.Objects.TlsConnection#g:method:getDatabase"), [getInputStream]("GI.Gio.Objects.IOStream#g:method:getInputStream"), [getInteraction]("GI.Gio.Objects.TlsConnection#g:method:getInteraction"), [getNegotiatedProtocol]("GI.Gio.Objects.TlsConnection#g:method:getNegotiatedProtocol"), [getOutputStream]("GI.Gio.Objects.IOStream#g:method:getOutputStream"), [getPeerCertificate]("GI.Gio.Objects.TlsConnection#g:method:getPeerCertificate"), [getPeerCertificateErrors]("GI.Gio.Objects.TlsConnection#g:method:getPeerCertificateErrors"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getProtocolVersion]("GI.Gio.Objects.TlsConnection#g:method:getProtocolVersion"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getRehandshakeMode]("GI.Gio.Objects.TlsConnection#g:method:getRehandshakeMode"), [getRequireCloseNotify]("GI.Gio.Objects.TlsConnection#g:method:getRequireCloseNotify"), [getUseSystemCertdb]("GI.Gio.Objects.TlsConnection#g:method:getUseSystemCertdb").
-- 
-- ==== Setters
-- [setAdvertisedProtocols]("GI.Gio.Objects.TlsConnection#g:method:setAdvertisedProtocols"), [setCertificate]("GI.Gio.Objects.TlsConnection#g:method:setCertificate"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setDatabase]("GI.Gio.Objects.TlsConnection#g:method:setDatabase"), [setInteraction]("GI.Gio.Objects.TlsConnection#g:method:setInteraction"), [setPending]("GI.Gio.Objects.IOStream#g:method:setPending"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setRehandshakeMode]("GI.Gio.Objects.TlsConnection#g:method:setRehandshakeMode"), [setRequireCloseNotify]("GI.Gio.Objects.TlsConnection#g:method:setRequireCloseNotify"), [setUseSystemCertdb]("GI.Gio.Objects.TlsConnection#g:method:setUseSystemCertdb").

#if defined(ENABLE_OVERLOADING)
    ResolveTlsServerConnectionMethod        ,
#endif

-- ** new #method:new#

    tlsServerConnectionNew                  ,




 -- * Properties


-- ** authenticationMode #attr:authenticationMode#
-- | The t'GI.Gio.Enums.TlsAuthenticationMode' for the server. This can be changed
-- before calling 'GI.Gio.Objects.TlsConnection.tlsConnectionHandshake' if you want to
-- rehandshake with a different mode from the initial handshake.
-- 
-- /Since: 2.28/

#if defined(ENABLE_OVERLOADING)
    TlsServerConnectionAuthenticationModePropertyInfo,
#endif
    constructTlsServerConnectionAuthenticationMode,
    getTlsServerConnectionAuthenticationMode,
    setTlsServerConnectionAuthenticationMode,
#if defined(ENABLE_OVERLOADING)
    tlsServerConnectionAuthenticationMode   ,
#endif




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.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 GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gio.Enums as Gio.Enums
import {-# SOURCE #-} qualified GI.Gio.Objects.IOStream as Gio.IOStream
import {-# SOURCE #-} qualified GI.Gio.Objects.TlsCertificate as Gio.TlsCertificate
import {-# SOURCE #-} qualified GI.Gio.Objects.TlsConnection as Gio.TlsConnection

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

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

foreign import ccall "g_tls_server_connection_get_type"
    c_g_tls_server_connection_get_type :: IO B.Types.GType

instance B.Types.TypedObject TlsServerConnection where
    glibType :: IO GType
glibType = IO GType
c_g_tls_server_connection_get_type

instance B.Types.GObject TlsServerConnection

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

instance O.HasParentTypes TlsServerConnection
type instance O.ParentTypes TlsServerConnection = '[GObject.Object.Object, Gio.TlsConnection.TlsConnection, Gio.IOStream.IOStream]

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

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

-- VVV Prop "authentication-mode"
   -- Type: TInterface (Name {namespace = "Gio", name = "TlsAuthenticationMode"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

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

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

-- | Construct a `GValueConstruct` with valid value for the “@authentication-mode@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTlsServerConnectionAuthenticationMode :: (IsTlsServerConnection o, MIO.MonadIO m) => Gio.Enums.TlsAuthenticationMode -> m (GValueConstruct o)
constructTlsServerConnectionAuthenticationMode :: forall o (m :: * -> *).
(IsTlsServerConnection o, MonadIO m) =>
TlsAuthenticationMode -> m (GValueConstruct o)
constructTlsServerConnectionAuthenticationMode TlsAuthenticationMode
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> TlsAuthenticationMode -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"authentication-mode" TlsAuthenticationMode
val

#if defined(ENABLE_OVERLOADING)
data TlsServerConnectionAuthenticationModePropertyInfo
instance AttrInfo TlsServerConnectionAuthenticationModePropertyInfo where
    type AttrAllowedOps TlsServerConnectionAuthenticationModePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint TlsServerConnectionAuthenticationModePropertyInfo = IsTlsServerConnection
    type AttrSetTypeConstraint TlsServerConnectionAuthenticationModePropertyInfo = (~) Gio.Enums.TlsAuthenticationMode
    type AttrTransferTypeConstraint TlsServerConnectionAuthenticationModePropertyInfo = (~) Gio.Enums.TlsAuthenticationMode
    type AttrTransferType TlsServerConnectionAuthenticationModePropertyInfo = Gio.Enums.TlsAuthenticationMode
    type AttrGetType TlsServerConnectionAuthenticationModePropertyInfo = Gio.Enums.TlsAuthenticationMode
    type AttrLabel TlsServerConnectionAuthenticationModePropertyInfo = "authentication-mode"
    type AttrOrigin TlsServerConnectionAuthenticationModePropertyInfo = TlsServerConnection
    attrGet = getTlsServerConnectionAuthenticationMode
    attrSet = setTlsServerConnectionAuthenticationMode
    attrTransfer _ v = do
        return v
    attrConstruct = constructTlsServerConnectionAuthenticationMode
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Interfaces.TlsServerConnection.authenticationMode"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.30/docs/GI-Gio-Interfaces-TlsServerConnection.html#g:attr:authenticationMode"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList TlsServerConnection
type instance O.AttributeList TlsServerConnection = TlsServerConnectionAttributeList
type TlsServerConnectionAttributeList = ('[ '("advertisedProtocols", Gio.TlsConnection.TlsConnectionAdvertisedProtocolsPropertyInfo), '("authenticationMode", TlsServerConnectionAuthenticationModePropertyInfo), '("baseIoStream", Gio.TlsConnection.TlsConnectionBaseIoStreamPropertyInfo), '("certificate", Gio.TlsConnection.TlsConnectionCertificatePropertyInfo), '("ciphersuiteName", Gio.TlsConnection.TlsConnectionCiphersuiteNamePropertyInfo), '("closed", Gio.IOStream.IOStreamClosedPropertyInfo), '("database", Gio.TlsConnection.TlsConnectionDatabasePropertyInfo), '("inputStream", Gio.IOStream.IOStreamInputStreamPropertyInfo), '("interaction", Gio.TlsConnection.TlsConnectionInteractionPropertyInfo), '("negotiatedProtocol", Gio.TlsConnection.TlsConnectionNegotiatedProtocolPropertyInfo), '("outputStream", Gio.IOStream.IOStreamOutputStreamPropertyInfo), '("peerCertificate", Gio.TlsConnection.TlsConnectionPeerCertificatePropertyInfo), '("peerCertificateErrors", Gio.TlsConnection.TlsConnectionPeerCertificateErrorsPropertyInfo), '("protocolVersion", Gio.TlsConnection.TlsConnectionProtocolVersionPropertyInfo), '("rehandshakeMode", Gio.TlsConnection.TlsConnectionRehandshakeModePropertyInfo), '("requireCloseNotify", Gio.TlsConnection.TlsConnectionRequireCloseNotifyPropertyInfo), '("useSystemCertdb", Gio.TlsConnection.TlsConnectionUseSystemCertdbPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
tlsServerConnectionAuthenticationMode :: AttrLabelProxy "authenticationMode"
tlsServerConnectionAuthenticationMode = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveTlsServerConnectionMethod (t :: Symbol) (o :: *) :: * where
    ResolveTlsServerConnectionMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveTlsServerConnectionMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveTlsServerConnectionMethod "clearPending" o = Gio.IOStream.IOStreamClearPendingMethodInfo
    ResolveTlsServerConnectionMethod "close" o = Gio.IOStream.IOStreamCloseMethodInfo
    ResolveTlsServerConnectionMethod "closeAsync" o = Gio.IOStream.IOStreamCloseAsyncMethodInfo
    ResolveTlsServerConnectionMethod "closeFinish" o = Gio.IOStream.IOStreamCloseFinishMethodInfo
    ResolveTlsServerConnectionMethod "emitAcceptCertificate" o = Gio.TlsConnection.TlsConnectionEmitAcceptCertificateMethodInfo
    ResolveTlsServerConnectionMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveTlsServerConnectionMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveTlsServerConnectionMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveTlsServerConnectionMethod "handshake" o = Gio.TlsConnection.TlsConnectionHandshakeMethodInfo
    ResolveTlsServerConnectionMethod "handshakeAsync" o = Gio.TlsConnection.TlsConnectionHandshakeAsyncMethodInfo
    ResolveTlsServerConnectionMethod "handshakeFinish" o = Gio.TlsConnection.TlsConnectionHandshakeFinishMethodInfo
    ResolveTlsServerConnectionMethod "hasPending" o = Gio.IOStream.IOStreamHasPendingMethodInfo
    ResolveTlsServerConnectionMethod "isClosed" o = Gio.IOStream.IOStreamIsClosedMethodInfo
    ResolveTlsServerConnectionMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveTlsServerConnectionMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveTlsServerConnectionMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveTlsServerConnectionMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveTlsServerConnectionMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveTlsServerConnectionMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveTlsServerConnectionMethod "spliceAsync" o = Gio.IOStream.IOStreamSpliceAsyncMethodInfo
    ResolveTlsServerConnectionMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveTlsServerConnectionMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveTlsServerConnectionMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveTlsServerConnectionMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveTlsServerConnectionMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveTlsServerConnectionMethod "getCertificate" o = Gio.TlsConnection.TlsConnectionGetCertificateMethodInfo
    ResolveTlsServerConnectionMethod "getChannelBindingData" o = Gio.TlsConnection.TlsConnectionGetChannelBindingDataMethodInfo
    ResolveTlsServerConnectionMethod "getCiphersuiteName" o = Gio.TlsConnection.TlsConnectionGetCiphersuiteNameMethodInfo
    ResolveTlsServerConnectionMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveTlsServerConnectionMethod "getDatabase" o = Gio.TlsConnection.TlsConnectionGetDatabaseMethodInfo
    ResolveTlsServerConnectionMethod "getInputStream" o = Gio.IOStream.IOStreamGetInputStreamMethodInfo
    ResolveTlsServerConnectionMethod "getInteraction" o = Gio.TlsConnection.TlsConnectionGetInteractionMethodInfo
    ResolveTlsServerConnectionMethod "getNegotiatedProtocol" o = Gio.TlsConnection.TlsConnectionGetNegotiatedProtocolMethodInfo
    ResolveTlsServerConnectionMethod "getOutputStream" o = Gio.IOStream.IOStreamGetOutputStreamMethodInfo
    ResolveTlsServerConnectionMethod "getPeerCertificate" o = Gio.TlsConnection.TlsConnectionGetPeerCertificateMethodInfo
    ResolveTlsServerConnectionMethod "getPeerCertificateErrors" o = Gio.TlsConnection.TlsConnectionGetPeerCertificateErrorsMethodInfo
    ResolveTlsServerConnectionMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveTlsServerConnectionMethod "getProtocolVersion" o = Gio.TlsConnection.TlsConnectionGetProtocolVersionMethodInfo
    ResolveTlsServerConnectionMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveTlsServerConnectionMethod "getRehandshakeMode" o = Gio.TlsConnection.TlsConnectionGetRehandshakeModeMethodInfo
    ResolveTlsServerConnectionMethod "getRequireCloseNotify" o = Gio.TlsConnection.TlsConnectionGetRequireCloseNotifyMethodInfo
    ResolveTlsServerConnectionMethod "getUseSystemCertdb" o = Gio.TlsConnection.TlsConnectionGetUseSystemCertdbMethodInfo
    ResolveTlsServerConnectionMethod "setAdvertisedProtocols" o = Gio.TlsConnection.TlsConnectionSetAdvertisedProtocolsMethodInfo
    ResolveTlsServerConnectionMethod "setCertificate" o = Gio.TlsConnection.TlsConnectionSetCertificateMethodInfo
    ResolveTlsServerConnectionMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveTlsServerConnectionMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveTlsServerConnectionMethod "setDatabase" o = Gio.TlsConnection.TlsConnectionSetDatabaseMethodInfo
    ResolveTlsServerConnectionMethod "setInteraction" o = Gio.TlsConnection.TlsConnectionSetInteractionMethodInfo
    ResolveTlsServerConnectionMethod "setPending" o = Gio.IOStream.IOStreamSetPendingMethodInfo
    ResolveTlsServerConnectionMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveTlsServerConnectionMethod "setRehandshakeMode" o = Gio.TlsConnection.TlsConnectionSetRehandshakeModeMethodInfo
    ResolveTlsServerConnectionMethod "setRequireCloseNotify" o = Gio.TlsConnection.TlsConnectionSetRequireCloseNotifyMethodInfo
    ResolveTlsServerConnectionMethod "setUseSystemCertdb" o = Gio.TlsConnection.TlsConnectionSetUseSystemCertdbMethodInfo
    ResolveTlsServerConnectionMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- method TlsServerConnection::new
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "base_io_stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "IOStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GIOStream to wrap"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "certificate"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "TlsCertificate" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the default server certificate, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Gio" , name = "TlsServerConnection" })
-- throws : True
-- Skip return : False

foreign import ccall "g_tls_server_connection_new" g_tls_server_connection_new :: 
    Ptr Gio.IOStream.IOStream ->            -- base_io_stream : TInterface (Name {namespace = "Gio", name = "IOStream"})
    Ptr Gio.TlsCertificate.TlsCertificate -> -- certificate : TInterface (Name {namespace = "Gio", name = "TlsCertificate"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr TlsServerConnection)

-- | Creates a new t'GI.Gio.Interfaces.TlsServerConnection.TlsServerConnection' wrapping /@baseIoStream@/ (which
-- must have pollable input and output streams).
-- 
-- See the documentation for [TlsConnection:baseIoStream]("GI.Gio.Objects.TlsConnection#g:attr:baseIoStream") for restrictions
-- on when application code can run operations on the /@baseIoStream@/ after
-- this function has returned.
-- 
-- /Since: 2.28/
tlsServerConnectionNew ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.IOStream.IsIOStream a, Gio.TlsCertificate.IsTlsCertificate b) =>
    a
    -- ^ /@baseIoStream@/: the t'GI.Gio.Objects.IOStream.IOStream' to wrap
    -> Maybe (b)
    -- ^ /@certificate@/: the default server certificate, or 'P.Nothing'
    -> m TlsServerConnection
    -- ^ __Returns:__ the new
    -- t'GI.Gio.Interfaces.TlsServerConnection.TlsServerConnection', or 'P.Nothing' on error /(Can throw 'Data.GI.Base.GError.GError')/
tlsServerConnectionNew :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsIOStream a, IsTlsCertificate b) =>
a -> Maybe b -> m TlsServerConnection
tlsServerConnectionNew a
baseIoStream Maybe b
certificate = IO TlsServerConnection -> m TlsServerConnection
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TlsServerConnection -> m TlsServerConnection)
-> IO TlsServerConnection -> m TlsServerConnection
forall a b. (a -> b) -> a -> b
$ do
    Ptr IOStream
baseIoStream' <- a -> IO (Ptr IOStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
baseIoStream
    Ptr TlsCertificate
maybeCertificate <- case Maybe b
certificate of
        Maybe b
Nothing -> Ptr TlsCertificate -> IO (Ptr TlsCertificate)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TlsCertificate
forall a. Ptr a
nullPtr
        Just b
jCertificate -> do
            Ptr TlsCertificate
jCertificate' <- b -> IO (Ptr TlsCertificate)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCertificate
            Ptr TlsCertificate -> IO (Ptr TlsCertificate)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TlsCertificate
jCertificate'
    IO TlsServerConnection -> IO () -> IO TlsServerConnection
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr TlsServerConnection
result <- (Ptr (Ptr GError) -> IO (Ptr TlsServerConnection))
-> IO (Ptr TlsServerConnection)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr TlsServerConnection))
 -> IO (Ptr TlsServerConnection))
-> (Ptr (Ptr GError) -> IO (Ptr TlsServerConnection))
-> IO (Ptr TlsServerConnection)
forall a b. (a -> b) -> a -> b
$ Ptr IOStream
-> Ptr TlsCertificate
-> Ptr (Ptr GError)
-> IO (Ptr TlsServerConnection)
g_tls_server_connection_new Ptr IOStream
baseIoStream' Ptr TlsCertificate
maybeCertificate
        Text -> Ptr TlsServerConnection -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"tlsServerConnectionNew" Ptr TlsServerConnection
result
        TlsServerConnection
result' <- ((ManagedPtr TlsServerConnection -> TlsServerConnection)
-> Ptr TlsServerConnection -> IO TlsServerConnection
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr TlsServerConnection -> TlsServerConnection
TlsServerConnection) Ptr TlsServerConnection
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
baseIoStream
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
certificate b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        TlsServerConnection -> IO TlsServerConnection
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TlsServerConnection
result'
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList TlsServerConnection = TlsServerConnectionSignalList
type TlsServerConnectionSignalList = ('[ '("acceptCertificate", Gio.TlsConnection.TlsConnectionAcceptCertificateSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif