{- |
Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
License    : LGPL-2.1
Maintainer : Iñaki García Etxebarria (garetxe@gmail.com)
-}

module GI.Gio.Objects.TlsConnection
    ( 

-- * Exported types
    TlsConnection(..)                       ,
    TlsConnectionK                          ,
    toTlsConnection                         ,
    noTlsConnection                         ,


 -- * Methods
-- ** tlsConnectionEmitAcceptCertificate
    tlsConnectionEmitAcceptCertificate      ,


-- ** tlsConnectionGetCertificate
    tlsConnectionGetCertificate             ,


-- ** tlsConnectionGetDatabase
    tlsConnectionGetDatabase                ,


-- ** tlsConnectionGetInteraction
    tlsConnectionGetInteraction             ,


-- ** tlsConnectionGetPeerCertificate
    tlsConnectionGetPeerCertificate         ,


-- ** tlsConnectionGetPeerCertificateErrors
    tlsConnectionGetPeerCertificateErrors   ,


-- ** tlsConnectionGetRehandshakeMode
    tlsConnectionGetRehandshakeMode         ,


-- ** tlsConnectionGetRequireCloseNotify
    tlsConnectionGetRequireCloseNotify      ,


-- ** tlsConnectionGetUseSystemCertdb
    tlsConnectionGetUseSystemCertdb         ,


-- ** tlsConnectionHandshake
    tlsConnectionHandshake                  ,


-- ** tlsConnectionHandshakeAsync
    tlsConnectionHandshakeAsync             ,


-- ** tlsConnectionHandshakeFinish
    tlsConnectionHandshakeFinish            ,


-- ** tlsConnectionSetCertificate
    tlsConnectionSetCertificate             ,


-- ** tlsConnectionSetDatabase
    tlsConnectionSetDatabase                ,


-- ** tlsConnectionSetInteraction
    tlsConnectionSetInteraction             ,


-- ** tlsConnectionSetRehandshakeMode
    tlsConnectionSetRehandshakeMode         ,


-- ** tlsConnectionSetRequireCloseNotify
    tlsConnectionSetRequireCloseNotify      ,


-- ** tlsConnectionSetUseSystemCertdb
    tlsConnectionSetUseSystemCertdb         ,




 -- * Properties
-- ** BaseIoStream
    TlsConnectionBaseIoStreamPropertyInfo   ,
    constructTlsConnectionBaseIoStream      ,
    getTlsConnectionBaseIoStream            ,


-- ** Certificate
    TlsConnectionCertificatePropertyInfo    ,
    constructTlsConnectionCertificate       ,
    getTlsConnectionCertificate             ,
    setTlsConnectionCertificate             ,


-- ** Database
    TlsConnectionDatabasePropertyInfo       ,
    constructTlsConnectionDatabase          ,
    getTlsConnectionDatabase                ,
    setTlsConnectionDatabase                ,


-- ** Interaction
    TlsConnectionInteractionPropertyInfo    ,
    constructTlsConnectionInteraction       ,
    getTlsConnectionInteraction             ,
    setTlsConnectionInteraction             ,


-- ** PeerCertificate
    TlsConnectionPeerCertificatePropertyInfo,
    getTlsConnectionPeerCertificate         ,


-- ** PeerCertificateErrors
    TlsConnectionPeerCertificateErrorsPropertyInfo,
    getTlsConnectionPeerCertificateErrors   ,


-- ** RehandshakeMode
    TlsConnectionRehandshakeModePropertyInfo,
    constructTlsConnectionRehandshakeMode   ,
    getTlsConnectionRehandshakeMode         ,
    setTlsConnectionRehandshakeMode         ,


-- ** RequireCloseNotify
    TlsConnectionRequireCloseNotifyPropertyInfo,
    constructTlsConnectionRequireCloseNotify,
    getTlsConnectionRequireCloseNotify      ,
    setTlsConnectionRequireCloseNotify      ,


-- ** UseSystemCertdb
    TlsConnectionUseSystemCertdbPropertyInfo,
    constructTlsConnectionUseSystemCertdb   ,
    getTlsConnectionUseSystemCertdb         ,
    setTlsConnectionUseSystemCertdb         ,




 -- * Signals
-- ** AcceptCertificate
    TlsConnectionAcceptCertificateCallback  ,
    TlsConnectionAcceptCertificateCallbackC ,
    TlsConnectionAcceptCertificateSignalInfo,
    afterTlsConnectionAcceptCertificate     ,
    mkTlsConnectionAcceptCertificateCallback,
    noTlsConnectionAcceptCertificateCallback,
    onTlsConnectionAcceptCertificate        ,
    tlsConnectionAcceptCertificateCallbackWrapper,
    tlsConnectionAcceptCertificateClosure   ,




    ) where

import Prelude ()
import Data.GI.Base.ShortPrelude

import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map

import GI.Gio.Types
import GI.Gio.Callbacks
import qualified GI.GObject as GObject

newtype TlsConnection = TlsConnection (ForeignPtr TlsConnection)
foreign import ccall "g_tls_connection_get_type"
    c_g_tls_connection_get_type :: IO GType

type instance ParentTypes TlsConnection = TlsConnectionParentTypes
type TlsConnectionParentTypes = '[IOStream, GObject.Object]

instance GObject TlsConnection where
    gobjectIsInitiallyUnowned _ = False
    gobjectType _ = c_g_tls_connection_get_type
    

class GObject o => TlsConnectionK o
instance (GObject o, IsDescendantOf TlsConnection o) => TlsConnectionK o

toTlsConnection :: TlsConnectionK o => o -> IO TlsConnection
toTlsConnection = unsafeCastTo TlsConnection

noTlsConnection :: Maybe TlsConnection
noTlsConnection = Nothing

-- signal TlsConnection::accept-certificate
type TlsConnectionAcceptCertificateCallback =
    TlsCertificate ->
    [TlsCertificateFlags] ->
    IO Bool

noTlsConnectionAcceptCertificateCallback :: Maybe TlsConnectionAcceptCertificateCallback
noTlsConnectionAcceptCertificateCallback = Nothing

type TlsConnectionAcceptCertificateCallbackC =
    Ptr () ->                               -- object
    Ptr TlsCertificate ->
    CUInt ->
    Ptr () ->                               -- user_data
    IO CInt

foreign import ccall "wrapper"
    mkTlsConnectionAcceptCertificateCallback :: TlsConnectionAcceptCertificateCallbackC -> IO (FunPtr TlsConnectionAcceptCertificateCallbackC)

tlsConnectionAcceptCertificateClosure :: TlsConnectionAcceptCertificateCallback -> IO Closure
tlsConnectionAcceptCertificateClosure cb = newCClosure =<< mkTlsConnectionAcceptCertificateCallback wrapped
    where wrapped = tlsConnectionAcceptCertificateCallbackWrapper cb

tlsConnectionAcceptCertificateCallbackWrapper ::
    TlsConnectionAcceptCertificateCallback ->
    Ptr () ->
    Ptr TlsCertificate ->
    CUInt ->
    Ptr () ->
    IO CInt
tlsConnectionAcceptCertificateCallbackWrapper _cb _ peer_cert errors _ = do
    peer_cert' <- (newObject TlsCertificate) peer_cert
    let errors' = wordToGFlags errors
    result <- _cb  peer_cert' errors'
    let result' = (fromIntegral . fromEnum) result
    return result'

onTlsConnectionAcceptCertificate :: (GObject a, MonadIO m) => a -> TlsConnectionAcceptCertificateCallback -> m SignalHandlerId
onTlsConnectionAcceptCertificate obj cb = liftIO $ connectTlsConnectionAcceptCertificate obj cb SignalConnectBefore
afterTlsConnectionAcceptCertificate :: (GObject a, MonadIO m) => a -> TlsConnectionAcceptCertificateCallback -> m SignalHandlerId
afterTlsConnectionAcceptCertificate obj cb = connectTlsConnectionAcceptCertificate obj cb SignalConnectAfter

connectTlsConnectionAcceptCertificate :: (GObject a, MonadIO m) =>
                                         a -> TlsConnectionAcceptCertificateCallback -> SignalConnectMode -> m SignalHandlerId
connectTlsConnectionAcceptCertificate obj cb after = liftIO $ do
    cb' <- mkTlsConnectionAcceptCertificateCallback (tlsConnectionAcceptCertificateCallbackWrapper cb)
    connectSignalFunPtr obj "accept-certificate" cb' after

-- VVV Prop "base-io-stream"
   -- Type: TInterface "Gio" "IOStream"
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]

getTlsConnectionBaseIoStream :: (MonadIO m, TlsConnectionK o) => o -> m IOStream
getTlsConnectionBaseIoStream obj = liftIO $ getObjectPropertyObject obj "base-io-stream" IOStream

constructTlsConnectionBaseIoStream :: (IOStreamK a) => a -> IO ([Char], GValue)
constructTlsConnectionBaseIoStream val = constructObjectPropertyObject "base-io-stream" val

data TlsConnectionBaseIoStreamPropertyInfo
instance AttrInfo TlsConnectionBaseIoStreamPropertyInfo where
    type AttrAllowedOps TlsConnectionBaseIoStreamPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint TlsConnectionBaseIoStreamPropertyInfo = IOStreamK
    type AttrBaseTypeConstraint TlsConnectionBaseIoStreamPropertyInfo = TlsConnectionK
    type AttrGetType TlsConnectionBaseIoStreamPropertyInfo = IOStream
    type AttrLabel TlsConnectionBaseIoStreamPropertyInfo = "TlsConnection::base-io-stream"
    attrGet _ = getTlsConnectionBaseIoStream
    attrSet _ = undefined
    attrConstruct _ = constructTlsConnectionBaseIoStream

-- VVV Prop "certificate"
   -- Type: TInterface "Gio" "TlsCertificate"
   -- Flags: [PropertyReadable,PropertyWritable]

getTlsConnectionCertificate :: (MonadIO m, TlsConnectionK o) => o -> m TlsCertificate
getTlsConnectionCertificate obj = liftIO $ getObjectPropertyObject obj "certificate" TlsCertificate

setTlsConnectionCertificate :: (MonadIO m, TlsConnectionK o, TlsCertificateK a) => o -> a -> m ()
setTlsConnectionCertificate obj val = liftIO $ setObjectPropertyObject obj "certificate" val

constructTlsConnectionCertificate :: (TlsCertificateK a) => a -> IO ([Char], GValue)
constructTlsConnectionCertificate val = constructObjectPropertyObject "certificate" val

data TlsConnectionCertificatePropertyInfo
instance AttrInfo TlsConnectionCertificatePropertyInfo where
    type AttrAllowedOps TlsConnectionCertificatePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint TlsConnectionCertificatePropertyInfo = TlsCertificateK
    type AttrBaseTypeConstraint TlsConnectionCertificatePropertyInfo = TlsConnectionK
    type AttrGetType TlsConnectionCertificatePropertyInfo = TlsCertificate
    type AttrLabel TlsConnectionCertificatePropertyInfo = "TlsConnection::certificate"
    attrGet _ = getTlsConnectionCertificate
    attrSet _ = setTlsConnectionCertificate
    attrConstruct _ = constructTlsConnectionCertificate

-- VVV Prop "database"
   -- Type: TInterface "Gio" "TlsDatabase"
   -- Flags: [PropertyReadable,PropertyWritable]

getTlsConnectionDatabase :: (MonadIO m, TlsConnectionK o) => o -> m TlsDatabase
getTlsConnectionDatabase obj = liftIO $ getObjectPropertyObject obj "database" TlsDatabase

setTlsConnectionDatabase :: (MonadIO m, TlsConnectionK o, TlsDatabaseK a) => o -> a -> m ()
setTlsConnectionDatabase obj val = liftIO $ setObjectPropertyObject obj "database" val

constructTlsConnectionDatabase :: (TlsDatabaseK a) => a -> IO ([Char], GValue)
constructTlsConnectionDatabase val = constructObjectPropertyObject "database" val

data TlsConnectionDatabasePropertyInfo
instance AttrInfo TlsConnectionDatabasePropertyInfo where
    type AttrAllowedOps TlsConnectionDatabasePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint TlsConnectionDatabasePropertyInfo = TlsDatabaseK
    type AttrBaseTypeConstraint TlsConnectionDatabasePropertyInfo = TlsConnectionK
    type AttrGetType TlsConnectionDatabasePropertyInfo = TlsDatabase
    type AttrLabel TlsConnectionDatabasePropertyInfo = "TlsConnection::database"
    attrGet _ = getTlsConnectionDatabase
    attrSet _ = setTlsConnectionDatabase
    attrConstruct _ = constructTlsConnectionDatabase

-- VVV Prop "interaction"
   -- Type: TInterface "Gio" "TlsInteraction"
   -- Flags: [PropertyReadable,PropertyWritable]

getTlsConnectionInteraction :: (MonadIO m, TlsConnectionK o) => o -> m TlsInteraction
getTlsConnectionInteraction obj = liftIO $ getObjectPropertyObject obj "interaction" TlsInteraction

setTlsConnectionInteraction :: (MonadIO m, TlsConnectionK o, TlsInteractionK a) => o -> a -> m ()
setTlsConnectionInteraction obj val = liftIO $ setObjectPropertyObject obj "interaction" val

constructTlsConnectionInteraction :: (TlsInteractionK a) => a -> IO ([Char], GValue)
constructTlsConnectionInteraction val = constructObjectPropertyObject "interaction" val

data TlsConnectionInteractionPropertyInfo
instance AttrInfo TlsConnectionInteractionPropertyInfo where
    type AttrAllowedOps TlsConnectionInteractionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint TlsConnectionInteractionPropertyInfo = TlsInteractionK
    type AttrBaseTypeConstraint TlsConnectionInteractionPropertyInfo = TlsConnectionK
    type AttrGetType TlsConnectionInteractionPropertyInfo = TlsInteraction
    type AttrLabel TlsConnectionInteractionPropertyInfo = "TlsConnection::interaction"
    attrGet _ = getTlsConnectionInteraction
    attrSet _ = setTlsConnectionInteraction
    attrConstruct _ = constructTlsConnectionInteraction

-- VVV Prop "peer-certificate"
   -- Type: TInterface "Gio" "TlsCertificate"
   -- Flags: [PropertyReadable]

getTlsConnectionPeerCertificate :: (MonadIO m, TlsConnectionK o) => o -> m TlsCertificate
getTlsConnectionPeerCertificate obj = liftIO $ getObjectPropertyObject obj "peer-certificate" TlsCertificate

data TlsConnectionPeerCertificatePropertyInfo
instance AttrInfo TlsConnectionPeerCertificatePropertyInfo where
    type AttrAllowedOps TlsConnectionPeerCertificatePropertyInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint TlsConnectionPeerCertificatePropertyInfo = (~) ()
    type AttrBaseTypeConstraint TlsConnectionPeerCertificatePropertyInfo = TlsConnectionK
    type AttrGetType TlsConnectionPeerCertificatePropertyInfo = TlsCertificate
    type AttrLabel TlsConnectionPeerCertificatePropertyInfo = "TlsConnection::peer-certificate"
    attrGet _ = getTlsConnectionPeerCertificate
    attrSet _ = undefined
    attrConstruct _ = undefined

-- VVV Prop "peer-certificate-errors"
   -- Type: TInterface "Gio" "TlsCertificateFlags"
   -- Flags: [PropertyReadable]

getTlsConnectionPeerCertificateErrors :: (MonadIO m, TlsConnectionK o) => o -> m [TlsCertificateFlags]
getTlsConnectionPeerCertificateErrors obj = liftIO $ getObjectPropertyFlags obj "peer-certificate-errors"

data TlsConnectionPeerCertificateErrorsPropertyInfo
instance AttrInfo TlsConnectionPeerCertificateErrorsPropertyInfo where
    type AttrAllowedOps TlsConnectionPeerCertificateErrorsPropertyInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint TlsConnectionPeerCertificateErrorsPropertyInfo = (~) ()
    type AttrBaseTypeConstraint TlsConnectionPeerCertificateErrorsPropertyInfo = TlsConnectionK
    type AttrGetType TlsConnectionPeerCertificateErrorsPropertyInfo = [TlsCertificateFlags]
    type AttrLabel TlsConnectionPeerCertificateErrorsPropertyInfo = "TlsConnection::peer-certificate-errors"
    attrGet _ = getTlsConnectionPeerCertificateErrors
    attrSet _ = undefined
    attrConstruct _ = undefined

-- VVV Prop "rehandshake-mode"
   -- Type: TInterface "Gio" "TlsRehandshakeMode"
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]

getTlsConnectionRehandshakeMode :: (MonadIO m, TlsConnectionK o) => o -> m TlsRehandshakeMode
getTlsConnectionRehandshakeMode obj = liftIO $ getObjectPropertyEnum obj "rehandshake-mode"

setTlsConnectionRehandshakeMode :: (MonadIO m, TlsConnectionK o) => o -> TlsRehandshakeMode -> m ()
setTlsConnectionRehandshakeMode obj val = liftIO $ setObjectPropertyEnum obj "rehandshake-mode" val

constructTlsConnectionRehandshakeMode :: TlsRehandshakeMode -> IO ([Char], GValue)
constructTlsConnectionRehandshakeMode val = constructObjectPropertyEnum "rehandshake-mode" val

data TlsConnectionRehandshakeModePropertyInfo
instance AttrInfo TlsConnectionRehandshakeModePropertyInfo where
    type AttrAllowedOps TlsConnectionRehandshakeModePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint TlsConnectionRehandshakeModePropertyInfo = (~) TlsRehandshakeMode
    type AttrBaseTypeConstraint TlsConnectionRehandshakeModePropertyInfo = TlsConnectionK
    type AttrGetType TlsConnectionRehandshakeModePropertyInfo = TlsRehandshakeMode
    type AttrLabel TlsConnectionRehandshakeModePropertyInfo = "TlsConnection::rehandshake-mode"
    attrGet _ = getTlsConnectionRehandshakeMode
    attrSet _ = setTlsConnectionRehandshakeMode
    attrConstruct _ = constructTlsConnectionRehandshakeMode

-- VVV Prop "require-close-notify"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]

getTlsConnectionRequireCloseNotify :: (MonadIO m, TlsConnectionK o) => o -> m Bool
getTlsConnectionRequireCloseNotify obj = liftIO $ getObjectPropertyBool obj "require-close-notify"

setTlsConnectionRequireCloseNotify :: (MonadIO m, TlsConnectionK o) => o -> Bool -> m ()
setTlsConnectionRequireCloseNotify obj val = liftIO $ setObjectPropertyBool obj "require-close-notify" val

constructTlsConnectionRequireCloseNotify :: Bool -> IO ([Char], GValue)
constructTlsConnectionRequireCloseNotify val = constructObjectPropertyBool "require-close-notify" val

data TlsConnectionRequireCloseNotifyPropertyInfo
instance AttrInfo TlsConnectionRequireCloseNotifyPropertyInfo where
    type AttrAllowedOps TlsConnectionRequireCloseNotifyPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint TlsConnectionRequireCloseNotifyPropertyInfo = (~) Bool
    type AttrBaseTypeConstraint TlsConnectionRequireCloseNotifyPropertyInfo = TlsConnectionK
    type AttrGetType TlsConnectionRequireCloseNotifyPropertyInfo = Bool
    type AttrLabel TlsConnectionRequireCloseNotifyPropertyInfo = "TlsConnection::require-close-notify"
    attrGet _ = getTlsConnectionRequireCloseNotify
    attrSet _ = setTlsConnectionRequireCloseNotify
    attrConstruct _ = constructTlsConnectionRequireCloseNotify

-- VVV Prop "use-system-certdb"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]

getTlsConnectionUseSystemCertdb :: (MonadIO m, TlsConnectionK o) => o -> m Bool
getTlsConnectionUseSystemCertdb obj = liftIO $ getObjectPropertyBool obj "use-system-certdb"

setTlsConnectionUseSystemCertdb :: (MonadIO m, TlsConnectionK o) => o -> Bool -> m ()
setTlsConnectionUseSystemCertdb obj val = liftIO $ setObjectPropertyBool obj "use-system-certdb" val

constructTlsConnectionUseSystemCertdb :: Bool -> IO ([Char], GValue)
constructTlsConnectionUseSystemCertdb val = constructObjectPropertyBool "use-system-certdb" val

data TlsConnectionUseSystemCertdbPropertyInfo
instance AttrInfo TlsConnectionUseSystemCertdbPropertyInfo where
    type AttrAllowedOps TlsConnectionUseSystemCertdbPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint TlsConnectionUseSystemCertdbPropertyInfo = (~) Bool
    type AttrBaseTypeConstraint TlsConnectionUseSystemCertdbPropertyInfo = TlsConnectionK
    type AttrGetType TlsConnectionUseSystemCertdbPropertyInfo = Bool
    type AttrLabel TlsConnectionUseSystemCertdbPropertyInfo = "TlsConnection::use-system-certdb"
    attrGet _ = getTlsConnectionUseSystemCertdb
    attrSet _ = setTlsConnectionUseSystemCertdb
    attrConstruct _ = constructTlsConnectionUseSystemCertdb

type instance AttributeList TlsConnection = TlsConnectionAttributeList
type TlsConnectionAttributeList = ('[ '("base-io-stream", TlsConnectionBaseIoStreamPropertyInfo), '("certificate", TlsConnectionCertificatePropertyInfo), '("closed", IOStreamClosedPropertyInfo), '("database", TlsConnectionDatabasePropertyInfo), '("input-stream", IOStreamInputStreamPropertyInfo), '("interaction", TlsConnectionInteractionPropertyInfo), '("output-stream", IOStreamOutputStreamPropertyInfo), '("peer-certificate", TlsConnectionPeerCertificatePropertyInfo), '("peer-certificate-errors", TlsConnectionPeerCertificateErrorsPropertyInfo), '("rehandshake-mode", TlsConnectionRehandshakeModePropertyInfo), '("require-close-notify", TlsConnectionRequireCloseNotifyPropertyInfo), '("use-system-certdb", TlsConnectionUseSystemCertdbPropertyInfo)] :: [(Symbol, *)])

data TlsConnectionAcceptCertificateSignalInfo
instance SignalInfo TlsConnectionAcceptCertificateSignalInfo where
    type HaskellCallbackType TlsConnectionAcceptCertificateSignalInfo = TlsConnectionAcceptCertificateCallback
    connectSignal _ = connectTlsConnectionAcceptCertificate

type instance SignalList TlsConnection = TlsConnectionSignalList
type TlsConnectionSignalList = ('[ '("accept-certificate", TlsConnectionAcceptCertificateSignalInfo), '("notify", GObject.ObjectNotifySignalInfo), '("notify::[property]", GObjectNotifySignalInfo)] :: [(Symbol, *)])

-- method TlsConnection::emit_accept_certificate
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "peer_cert", argType = TInterface "Gio" "TlsCertificate", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "errors", argType = TInterface "Gio" "TlsCertificateFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "peer_cert", argType = TInterface "Gio" "TlsCertificate", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "errors", argType = TInterface "Gio" "TlsCertificateFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "g_tls_connection_emit_accept_certificate" g_tls_connection_emit_accept_certificate :: 
    Ptr TlsConnection ->                    -- _obj : TInterface "Gio" "TlsConnection"
    Ptr TlsCertificate ->                   -- peer_cert : TInterface "Gio" "TlsCertificate"
    CUInt ->                                -- errors : TInterface "Gio" "TlsCertificateFlags"
    IO CInt


tlsConnectionEmitAcceptCertificate ::
    (MonadIO m, TlsConnectionK a, TlsCertificateK b) =>
    a ->                                    -- _obj
    b ->                                    -- peer_cert
    [TlsCertificateFlags] ->                -- errors
    m Bool
tlsConnectionEmitAcceptCertificate _obj peer_cert errors = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let peer_cert' = unsafeManagedPtrCastPtr peer_cert
    let errors' = gflagsToWord errors
    result <- g_tls_connection_emit_accept_certificate _obj' peer_cert' errors'
    let result' = (/= 0) result
    touchManagedPtr _obj
    touchManagedPtr peer_cert
    return result'

-- method TlsConnection::get_certificate
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gio" "TlsCertificate"
-- throws : False
-- Skip return : False

foreign import ccall "g_tls_connection_get_certificate" g_tls_connection_get_certificate :: 
    Ptr TlsConnection ->                    -- _obj : TInterface "Gio" "TlsConnection"
    IO (Ptr TlsCertificate)


tlsConnectionGetCertificate ::
    (MonadIO m, TlsConnectionK a) =>
    a ->                                    -- _obj
    m TlsCertificate
tlsConnectionGetCertificate _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- g_tls_connection_get_certificate _obj'
    checkUnexpectedReturnNULL "g_tls_connection_get_certificate" result
    result' <- (newObject TlsCertificate) result
    touchManagedPtr _obj
    return result'

-- method TlsConnection::get_database
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gio" "TlsDatabase"
-- throws : False
-- Skip return : False

foreign import ccall "g_tls_connection_get_database" g_tls_connection_get_database :: 
    Ptr TlsConnection ->                    -- _obj : TInterface "Gio" "TlsConnection"
    IO (Ptr TlsDatabase)


tlsConnectionGetDatabase ::
    (MonadIO m, TlsConnectionK a) =>
    a ->                                    -- _obj
    m TlsDatabase
tlsConnectionGetDatabase _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- g_tls_connection_get_database _obj'
    checkUnexpectedReturnNULL "g_tls_connection_get_database" result
    result' <- (newObject TlsDatabase) result
    touchManagedPtr _obj
    return result'

-- method TlsConnection::get_interaction
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gio" "TlsInteraction"
-- throws : False
-- Skip return : False

foreign import ccall "g_tls_connection_get_interaction" g_tls_connection_get_interaction :: 
    Ptr TlsConnection ->                    -- _obj : TInterface "Gio" "TlsConnection"
    IO (Ptr TlsInteraction)


tlsConnectionGetInteraction ::
    (MonadIO m, TlsConnectionK a) =>
    a ->                                    -- _obj
    m TlsInteraction
tlsConnectionGetInteraction _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- g_tls_connection_get_interaction _obj'
    checkUnexpectedReturnNULL "g_tls_connection_get_interaction" result
    result' <- (newObject TlsInteraction) result
    touchManagedPtr _obj
    return result'

-- method TlsConnection::get_peer_certificate
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gio" "TlsCertificate"
-- throws : False
-- Skip return : False

foreign import ccall "g_tls_connection_get_peer_certificate" g_tls_connection_get_peer_certificate :: 
    Ptr TlsConnection ->                    -- _obj : TInterface "Gio" "TlsConnection"
    IO (Ptr TlsCertificate)


tlsConnectionGetPeerCertificate ::
    (MonadIO m, TlsConnectionK a) =>
    a ->                                    -- _obj
    m TlsCertificate
tlsConnectionGetPeerCertificate _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- g_tls_connection_get_peer_certificate _obj'
    checkUnexpectedReturnNULL "g_tls_connection_get_peer_certificate" result
    result' <- (newObject TlsCertificate) result
    touchManagedPtr _obj
    return result'

-- method TlsConnection::get_peer_certificate_errors
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gio" "TlsCertificateFlags"
-- throws : False
-- Skip return : False

foreign import ccall "g_tls_connection_get_peer_certificate_errors" g_tls_connection_get_peer_certificate_errors :: 
    Ptr TlsConnection ->                    -- _obj : TInterface "Gio" "TlsConnection"
    IO CUInt


tlsConnectionGetPeerCertificateErrors ::
    (MonadIO m, TlsConnectionK a) =>
    a ->                                    -- _obj
    m [TlsCertificateFlags]
tlsConnectionGetPeerCertificateErrors _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- g_tls_connection_get_peer_certificate_errors _obj'
    let result' = wordToGFlags result
    touchManagedPtr _obj
    return result'

-- method TlsConnection::get_rehandshake_mode
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gio" "TlsRehandshakeMode"
-- throws : False
-- Skip return : False

foreign import ccall "g_tls_connection_get_rehandshake_mode" g_tls_connection_get_rehandshake_mode :: 
    Ptr TlsConnection ->                    -- _obj : TInterface "Gio" "TlsConnection"
    IO CUInt


tlsConnectionGetRehandshakeMode ::
    (MonadIO m, TlsConnectionK a) =>
    a ->                                    -- _obj
    m TlsRehandshakeMode
tlsConnectionGetRehandshakeMode _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- g_tls_connection_get_rehandshake_mode _obj'
    let result' = (toEnum . fromIntegral) result
    touchManagedPtr _obj
    return result'

-- method TlsConnection::get_require_close_notify
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "g_tls_connection_get_require_close_notify" g_tls_connection_get_require_close_notify :: 
    Ptr TlsConnection ->                    -- _obj : TInterface "Gio" "TlsConnection"
    IO CInt


tlsConnectionGetRequireCloseNotify ::
    (MonadIO m, TlsConnectionK a) =>
    a ->                                    -- _obj
    m Bool
tlsConnectionGetRequireCloseNotify _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- g_tls_connection_get_require_close_notify _obj'
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method TlsConnection::get_use_system_certdb
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "g_tls_connection_get_use_system_certdb" g_tls_connection_get_use_system_certdb :: 
    Ptr TlsConnection ->                    -- _obj : TInterface "Gio" "TlsConnection"
    IO CInt

{-# DEPRECATED tlsConnectionGetUseSystemCertdb ["(Since version 2.30)","Use g_tls_connection_get_database() instead"]#-}
tlsConnectionGetUseSystemCertdb ::
    (MonadIO m, TlsConnectionK a) =>
    a ->                                    -- _obj
    m Bool
tlsConnectionGetUseSystemCertdb _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- g_tls_connection_get_use_system_certdb _obj'
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method TlsConnection::handshake
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : True
-- Skip return : False

foreign import ccall "g_tls_connection_handshake" g_tls_connection_handshake :: 
    Ptr TlsConnection ->                    -- _obj : TInterface "Gio" "TlsConnection"
    Ptr Cancellable ->                      -- cancellable : TInterface "Gio" "Cancellable"
    Ptr (Ptr GError) ->                     -- error
    IO CInt


tlsConnectionHandshake ::
    (MonadIO m, TlsConnectionK a, CancellableK b) =>
    a ->                                    -- _obj
    Maybe (b) ->                            -- cancellable
    m ()
tlsConnectionHandshake _obj cancellable = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeCancellable <- case cancellable of
        Nothing -> return nullPtr
        Just jCancellable -> do
            let jCancellable' = unsafeManagedPtrCastPtr jCancellable
            return jCancellable'
    onException (do
        _ <- propagateGError $ g_tls_connection_handshake _obj' maybeCancellable
        touchManagedPtr _obj
        whenJust cancellable touchManagedPtr
        return ()
     ) (do
        return ()
     )

-- method TlsConnection::handshake_async
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, argDestroy = -1, transfer = TransferNothing},Arg {argName = "user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "io_priority", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gio" "AsyncReadyCallback", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = 4, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "g_tls_connection_handshake_async" g_tls_connection_handshake_async :: 
    Ptr TlsConnection ->                    -- _obj : TInterface "Gio" "TlsConnection"
    Int32 ->                                -- io_priority : TBasicType TInt32
    Ptr Cancellable ->                      -- cancellable : TInterface "Gio" "Cancellable"
    FunPtr AsyncReadyCallbackC ->           -- callback : TInterface "Gio" "AsyncReadyCallback"
    Ptr () ->                               -- user_data : TBasicType TVoid
    IO ()


tlsConnectionHandshakeAsync ::
    (MonadIO m, TlsConnectionK a, CancellableK b) =>
    a ->                                    -- _obj
    Int32 ->                                -- io_priority
    Maybe (b) ->                            -- cancellable
    Maybe (AsyncReadyCallback) ->           -- callback
    m ()
tlsConnectionHandshakeAsync _obj io_priority cancellable callback = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeCancellable <- case cancellable of
        Nothing -> return nullPtr
        Just jCancellable -> do
            let jCancellable' = unsafeManagedPtrCastPtr jCancellable
            return jCancellable'
    ptrcallback <- callocMem :: IO (Ptr (FunPtr AsyncReadyCallbackC))
    maybeCallback <- case callback of
        Nothing -> return (castPtrToFunPtr nullPtr)
        Just jCallback -> do
            jCallback' <- mkAsyncReadyCallback (asyncReadyCallbackWrapper (Just ptrcallback) jCallback)
            poke ptrcallback jCallback'
            return jCallback'
    let user_data = nullPtr
    g_tls_connection_handshake_async _obj' io_priority maybeCancellable maybeCallback user_data
    touchManagedPtr _obj
    whenJust cancellable touchManagedPtr
    return ()

-- method TlsConnection::handshake_finish
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "result", argType = TInterface "Gio" "AsyncResult", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : True
-- Skip return : False

foreign import ccall "g_tls_connection_handshake_finish" g_tls_connection_handshake_finish :: 
    Ptr TlsConnection ->                    -- _obj : TInterface "Gio" "TlsConnection"
    Ptr AsyncResult ->                      -- result : TInterface "Gio" "AsyncResult"
    Ptr (Ptr GError) ->                     -- error
    IO CInt


tlsConnectionHandshakeFinish ::
    (MonadIO m, TlsConnectionK a, AsyncResultK b) =>
    a ->                                    -- _obj
    b ->                                    -- result
    m ()
tlsConnectionHandshakeFinish _obj result_ = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let result_' = unsafeManagedPtrCastPtr result_
    onException (do
        _ <- propagateGError $ g_tls_connection_handshake_finish _obj' result_'
        touchManagedPtr _obj
        touchManagedPtr result_
        return ()
     ) (do
        return ()
     )

-- method TlsConnection::set_certificate
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "certificate", argType = TInterface "Gio" "TlsCertificate", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "certificate", argType = TInterface "Gio" "TlsCertificate", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "g_tls_connection_set_certificate" g_tls_connection_set_certificate :: 
    Ptr TlsConnection ->                    -- _obj : TInterface "Gio" "TlsConnection"
    Ptr TlsCertificate ->                   -- certificate : TInterface "Gio" "TlsCertificate"
    IO ()


tlsConnectionSetCertificate ::
    (MonadIO m, TlsConnectionK a, TlsCertificateK b) =>
    a ->                                    -- _obj
    b ->                                    -- certificate
    m ()
tlsConnectionSetCertificate _obj certificate = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let certificate' = unsafeManagedPtrCastPtr certificate
    g_tls_connection_set_certificate _obj' certificate'
    touchManagedPtr _obj
    touchManagedPtr certificate
    return ()

-- method TlsConnection::set_database
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "database", argType = TInterface "Gio" "TlsDatabase", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "database", argType = TInterface "Gio" "TlsDatabase", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "g_tls_connection_set_database" g_tls_connection_set_database :: 
    Ptr TlsConnection ->                    -- _obj : TInterface "Gio" "TlsConnection"
    Ptr TlsDatabase ->                      -- database : TInterface "Gio" "TlsDatabase"
    IO ()


tlsConnectionSetDatabase ::
    (MonadIO m, TlsConnectionK a, TlsDatabaseK b) =>
    a ->                                    -- _obj
    b ->                                    -- database
    m ()
tlsConnectionSetDatabase _obj database = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let database' = unsafeManagedPtrCastPtr database
    g_tls_connection_set_database _obj' database'
    touchManagedPtr _obj
    touchManagedPtr database
    return ()

-- method TlsConnection::set_interaction
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interaction", argType = TInterface "Gio" "TlsInteraction", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interaction", argType = TInterface "Gio" "TlsInteraction", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "g_tls_connection_set_interaction" g_tls_connection_set_interaction :: 
    Ptr TlsConnection ->                    -- _obj : TInterface "Gio" "TlsConnection"
    Ptr TlsInteraction ->                   -- interaction : TInterface "Gio" "TlsInteraction"
    IO ()


tlsConnectionSetInteraction ::
    (MonadIO m, TlsConnectionK a, TlsInteractionK b) =>
    a ->                                    -- _obj
    Maybe (b) ->                            -- interaction
    m ()
tlsConnectionSetInteraction _obj interaction = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeInteraction <- case interaction of
        Nothing -> return nullPtr
        Just jInteraction -> do
            let jInteraction' = unsafeManagedPtrCastPtr jInteraction
            return jInteraction'
    g_tls_connection_set_interaction _obj' maybeInteraction
    touchManagedPtr _obj
    whenJust interaction touchManagedPtr
    return ()

-- method TlsConnection::set_rehandshake_mode
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mode", argType = TInterface "Gio" "TlsRehandshakeMode", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mode", argType = TInterface "Gio" "TlsRehandshakeMode", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "g_tls_connection_set_rehandshake_mode" g_tls_connection_set_rehandshake_mode :: 
    Ptr TlsConnection ->                    -- _obj : TInterface "Gio" "TlsConnection"
    CUInt ->                                -- mode : TInterface "Gio" "TlsRehandshakeMode"
    IO ()


tlsConnectionSetRehandshakeMode ::
    (MonadIO m, TlsConnectionK a) =>
    a ->                                    -- _obj
    TlsRehandshakeMode ->                   -- mode
    m ()
tlsConnectionSetRehandshakeMode _obj mode = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let mode' = (fromIntegral . fromEnum) mode
    g_tls_connection_set_rehandshake_mode _obj' mode'
    touchManagedPtr _obj
    return ()

-- method TlsConnection::set_require_close_notify
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "require_close_notify", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "require_close_notify", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "g_tls_connection_set_require_close_notify" g_tls_connection_set_require_close_notify :: 
    Ptr TlsConnection ->                    -- _obj : TInterface "Gio" "TlsConnection"
    CInt ->                                 -- require_close_notify : TBasicType TBoolean
    IO ()


tlsConnectionSetRequireCloseNotify ::
    (MonadIO m, TlsConnectionK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- require_close_notify
    m ()
tlsConnectionSetRequireCloseNotify _obj require_close_notify = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let require_close_notify' = (fromIntegral . fromEnum) require_close_notify
    g_tls_connection_set_require_close_notify _obj' require_close_notify'
    touchManagedPtr _obj
    return ()

-- method TlsConnection::set_use_system_certdb
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "use_system_certdb", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "TlsConnection", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "use_system_certdb", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "g_tls_connection_set_use_system_certdb" g_tls_connection_set_use_system_certdb :: 
    Ptr TlsConnection ->                    -- _obj : TInterface "Gio" "TlsConnection"
    CInt ->                                 -- use_system_certdb : TBasicType TBoolean
    IO ()

{-# DEPRECATED tlsConnectionSetUseSystemCertdb ["(Since version 2.30)","Use g_tls_connection_set_database() instead"]#-}
tlsConnectionSetUseSystemCertdb ::
    (MonadIO m, TlsConnectionK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- use_system_certdb
    m ()
tlsConnectionSetUseSystemCertdb _obj use_system_certdb = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let use_system_certdb' = (fromIntegral . fromEnum) use_system_certdb
    g_tls_connection_set_use_system_certdb _obj' use_system_certdb'
    touchManagedPtr _obj
    return ()