{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- @GTlsDatabase@ is used to look up certificates and other information
-- from a certificate or key store. It is an abstract base class which
-- TLS library specific subtypes override.
-- 
-- A @GTlsDatabase@ may be accessed from multiple threads by the TLS backend.
-- All implementations are required to be fully thread-safe.
-- 
-- Most common client applications will not directly interact with
-- @GTlsDatabase@. It is used internally by t'GI.Gio.Objects.TlsConnection.TlsConnection'.
-- 
-- /Since: 2.30/

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

module GI.Gio.Objects.TlsDatabase
    ( 

-- * Exported types
    TlsDatabase(..)                         ,
    IsTlsDatabase                           ,
    toTlsDatabase                           ,


 -- * 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"), [createCertificateHandle]("GI.Gio.Objects.TlsDatabase#g:method:createCertificateHandle"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [lookupCertificateForHandle]("GI.Gio.Objects.TlsDatabase#g:method:lookupCertificateForHandle"), [lookupCertificateForHandleAsync]("GI.Gio.Objects.TlsDatabase#g:method:lookupCertificateForHandleAsync"), [lookupCertificateForHandleFinish]("GI.Gio.Objects.TlsDatabase#g:method:lookupCertificateForHandleFinish"), [lookupCertificateIssuer]("GI.Gio.Objects.TlsDatabase#g:method:lookupCertificateIssuer"), [lookupCertificateIssuerAsync]("GI.Gio.Objects.TlsDatabase#g:method:lookupCertificateIssuerAsync"), [lookupCertificateIssuerFinish]("GI.Gio.Objects.TlsDatabase#g:method:lookupCertificateIssuerFinish"), [lookupCertificatesIssuedBy]("GI.Gio.Objects.TlsDatabase#g:method:lookupCertificatesIssuedBy"), [lookupCertificatesIssuedByAsync]("GI.Gio.Objects.TlsDatabase#g:method:lookupCertificatesIssuedByAsync"), [lookupCertificatesIssuedByFinish]("GI.Gio.Objects.TlsDatabase#g:method:lookupCertificatesIssuedByFinish"), [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"), [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"), [verifyChain]("GI.Gio.Objects.TlsDatabase#g:method:verifyChain"), [verifyChainAsync]("GI.Gio.Objects.TlsDatabase#g:method:verifyChainAsync"), [verifyChainFinish]("GI.Gio.Objects.TlsDatabase#g:method:verifyChainFinish"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveTlsDatabaseMethod                ,
#endif

-- ** createCertificateHandle #method:createCertificateHandle#

#if defined(ENABLE_OVERLOADING)
    TlsDatabaseCreateCertificateHandleMethodInfo,
#endif
    tlsDatabaseCreateCertificateHandle      ,


-- ** lookupCertificateForHandle #method:lookupCertificateForHandle#

#if defined(ENABLE_OVERLOADING)
    TlsDatabaseLookupCertificateForHandleMethodInfo,
#endif
    tlsDatabaseLookupCertificateForHandle   ,


-- ** lookupCertificateForHandleAsync #method:lookupCertificateForHandleAsync#

#if defined(ENABLE_OVERLOADING)
    TlsDatabaseLookupCertificateForHandleAsyncMethodInfo,
#endif
    tlsDatabaseLookupCertificateForHandleAsync,


-- ** lookupCertificateForHandleFinish #method:lookupCertificateForHandleFinish#

#if defined(ENABLE_OVERLOADING)
    TlsDatabaseLookupCertificateForHandleFinishMethodInfo,
#endif
    tlsDatabaseLookupCertificateForHandleFinish,


-- ** lookupCertificateIssuer #method:lookupCertificateIssuer#

#if defined(ENABLE_OVERLOADING)
    TlsDatabaseLookupCertificateIssuerMethodInfo,
#endif
    tlsDatabaseLookupCertificateIssuer      ,


-- ** lookupCertificateIssuerAsync #method:lookupCertificateIssuerAsync#

#if defined(ENABLE_OVERLOADING)
    TlsDatabaseLookupCertificateIssuerAsyncMethodInfo,
#endif
    tlsDatabaseLookupCertificateIssuerAsync ,


-- ** lookupCertificateIssuerFinish #method:lookupCertificateIssuerFinish#

#if defined(ENABLE_OVERLOADING)
    TlsDatabaseLookupCertificateIssuerFinishMethodInfo,
#endif
    tlsDatabaseLookupCertificateIssuerFinish,


-- ** lookupCertificatesIssuedBy #method:lookupCertificatesIssuedBy#

#if defined(ENABLE_OVERLOADING)
    TlsDatabaseLookupCertificatesIssuedByMethodInfo,
#endif
    tlsDatabaseLookupCertificatesIssuedBy   ,


-- ** lookupCertificatesIssuedByAsync #method:lookupCertificatesIssuedByAsync#

#if defined(ENABLE_OVERLOADING)
    TlsDatabaseLookupCertificatesIssuedByAsyncMethodInfo,
#endif
    tlsDatabaseLookupCertificatesIssuedByAsync,


-- ** lookupCertificatesIssuedByFinish #method:lookupCertificatesIssuedByFinish#

#if defined(ENABLE_OVERLOADING)
    TlsDatabaseLookupCertificatesIssuedByFinishMethodInfo,
#endif
    tlsDatabaseLookupCertificatesIssuedByFinish,


-- ** verifyChain #method:verifyChain#

#if defined(ENABLE_OVERLOADING)
    TlsDatabaseVerifyChainMethodInfo        ,
#endif
    tlsDatabaseVerifyChain                  ,


-- ** verifyChainAsync #method:verifyChainAsync#

#if defined(ENABLE_OVERLOADING)
    TlsDatabaseVerifyChainAsyncMethodInfo   ,
#endif
    tlsDatabaseVerifyChainAsync             ,


-- ** verifyChainFinish #method:verifyChainFinish#

#if defined(ENABLE_OVERLOADING)
    TlsDatabaseVerifyChainFinishMethodInfo  ,
#endif
    tlsDatabaseVerifyChainFinish            ,




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R
import qualified Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.GLib.Structs.Bytes as GLib.Bytes
import qualified GI.GLib.Structs.DateTime as GLib.DateTime
import qualified GI.GLib.Structs.PollFD as GLib.PollFD
import qualified GI.GLib.Structs.Source as GLib.Source
import qualified GI.GObject.Callbacks as GObject.Callbacks
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Callbacks as Gio.Callbacks
import {-# SOURCE #-} qualified GI.Gio.Enums as Gio.Enums
import {-# SOURCE #-} qualified GI.Gio.Flags as Gio.Flags
import {-# SOURCE #-} qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import {-# SOURCE #-} qualified GI.Gio.Interfaces.SocketConnectable as Gio.SocketConnectable
import {-# SOURCE #-} qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import {-# SOURCE #-} qualified GI.Gio.Objects.IOStream as Gio.IOStream
import {-# SOURCE #-} qualified GI.Gio.Objects.InetAddress as Gio.InetAddress
import {-# SOURCE #-} qualified GI.Gio.Objects.InputStream as Gio.InputStream
import {-# SOURCE #-} qualified GI.Gio.Objects.OutputStream as Gio.OutputStream
import {-# SOURCE #-} qualified GI.Gio.Objects.SocketAddress as Gio.SocketAddress
import {-# SOURCE #-} qualified GI.Gio.Objects.SocketAddressEnumerator as Gio.SocketAddressEnumerator
import {-# SOURCE #-} qualified GI.Gio.Objects.TlsCertificate as Gio.TlsCertificate
import {-# SOURCE #-} qualified GI.Gio.Objects.TlsConnection as Gio.TlsConnection
import {-# SOURCE #-} qualified GI.Gio.Objects.TlsInteraction as Gio.TlsInteraction
import {-# SOURCE #-} qualified GI.Gio.Objects.TlsPassword as Gio.TlsPassword
import {-# SOURCE #-} qualified GI.Gio.Structs.OutputVector as Gio.OutputVector

#else
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Callbacks as Gio.Callbacks
import {-# SOURCE #-} qualified GI.Gio.Enums as Gio.Enums
import {-# SOURCE #-} qualified GI.Gio.Flags as Gio.Flags
import {-# SOURCE #-} qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import {-# SOURCE #-} qualified GI.Gio.Interfaces.SocketConnectable as Gio.SocketConnectable
import {-# SOURCE #-} qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import {-# SOURCE #-} qualified GI.Gio.Objects.TlsCertificate as Gio.TlsCertificate
import {-# SOURCE #-} qualified GI.Gio.Objects.TlsInteraction as Gio.TlsInteraction

#endif

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

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

foreign import ccall "g_tls_database_get_type"
    c_g_tls_database_get_type :: IO B.Types.GType

instance B.Types.TypedObject TlsDatabase where
    glibType :: IO GType
glibType = IO GType
c_g_tls_database_get_type

instance B.Types.GObject TlsDatabase

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

instance O.HasParentTypes TlsDatabase
type instance O.ParentTypes TlsDatabase = '[GObject.Object.Object]

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

-- | Convert 'TlsDatabase' 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 TlsDatabase) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_g_tls_database_get_type
    gvalueSet_ :: Ptr GValue -> Maybe TlsDatabase -> IO ()
gvalueSet_ Ptr GValue
gv Maybe TlsDatabase
P.Nothing = Ptr GValue -> Ptr TlsDatabase -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr TlsDatabase
forall a. Ptr a
FP.nullPtr :: FP.Ptr TlsDatabase)
    gvalueSet_ Ptr GValue
gv (P.Just TlsDatabase
obj) = TlsDatabase -> (Ptr TlsDatabase -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr TlsDatabase
obj (Ptr GValue -> Ptr TlsDatabase -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe TlsDatabase)
gvalueGet_ Ptr GValue
gv = do
        ptr <- Ptr GValue -> IO (Ptr TlsDatabase)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr TlsDatabase)
        if ptr /= FP.nullPtr
        then P.Just <$> B.ManagedPtr.newObject TlsDatabase ptr
        else return P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveTlsDatabaseMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveTlsDatabaseMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveTlsDatabaseMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveTlsDatabaseMethod "createCertificateHandle" o = TlsDatabaseCreateCertificateHandleMethodInfo
    ResolveTlsDatabaseMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveTlsDatabaseMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveTlsDatabaseMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveTlsDatabaseMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveTlsDatabaseMethod "lookupCertificateForHandle" o = TlsDatabaseLookupCertificateForHandleMethodInfo
    ResolveTlsDatabaseMethod "lookupCertificateForHandleAsync" o = TlsDatabaseLookupCertificateForHandleAsyncMethodInfo
    ResolveTlsDatabaseMethod "lookupCertificateForHandleFinish" o = TlsDatabaseLookupCertificateForHandleFinishMethodInfo
    ResolveTlsDatabaseMethod "lookupCertificateIssuer" o = TlsDatabaseLookupCertificateIssuerMethodInfo
    ResolveTlsDatabaseMethod "lookupCertificateIssuerAsync" o = TlsDatabaseLookupCertificateIssuerAsyncMethodInfo
    ResolveTlsDatabaseMethod "lookupCertificateIssuerFinish" o = TlsDatabaseLookupCertificateIssuerFinishMethodInfo
    ResolveTlsDatabaseMethod "lookupCertificatesIssuedBy" o = TlsDatabaseLookupCertificatesIssuedByMethodInfo
    ResolveTlsDatabaseMethod "lookupCertificatesIssuedByAsync" o = TlsDatabaseLookupCertificatesIssuedByAsyncMethodInfo
    ResolveTlsDatabaseMethod "lookupCertificatesIssuedByFinish" o = TlsDatabaseLookupCertificatesIssuedByFinishMethodInfo
    ResolveTlsDatabaseMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveTlsDatabaseMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveTlsDatabaseMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveTlsDatabaseMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveTlsDatabaseMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveTlsDatabaseMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveTlsDatabaseMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveTlsDatabaseMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveTlsDatabaseMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveTlsDatabaseMethod "verifyChain" o = TlsDatabaseVerifyChainMethodInfo
    ResolveTlsDatabaseMethod "verifyChainAsync" o = TlsDatabaseVerifyChainAsyncMethodInfo
    ResolveTlsDatabaseMethod "verifyChainFinish" o = TlsDatabaseVerifyChainFinishMethodInfo
    ResolveTlsDatabaseMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveTlsDatabaseMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveTlsDatabaseMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveTlsDatabaseMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveTlsDatabaseMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveTlsDatabaseMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveTlsDatabaseMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveTlsDatabaseMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

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

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList TlsDatabase = TlsDatabaseSignalList
type TlsDatabaseSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])

#endif

-- method TlsDatabase::create_certificate_handle
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "TlsDatabase" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GTlsDatabase" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "certificate"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "TlsCertificate" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "certificate for which to create a handle."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "g_tls_database_create_certificate_handle" g_tls_database_create_certificate_handle :: 
    Ptr TlsDatabase ->                      -- self : TInterface (Name {namespace = "Gio", name = "TlsDatabase"})
    Ptr Gio.TlsCertificate.TlsCertificate -> -- certificate : TInterface (Name {namespace = "Gio", name = "TlsCertificate"})
    IO CString

-- | Create a handle string for the certificate. The database will only be able
-- to create a handle for certificates that originate from the database. In
-- cases where the database cannot create a handle for a certificate, 'P.Nothing'
-- will be returned.
-- 
-- This handle should be stable across various instances of the application,
-- and between applications. If a certificate is modified in the database,
-- then it is not guaranteed that this handle will continue to point to it.
-- 
-- /Since: 2.30/
tlsDatabaseCreateCertificateHandle ::
    (B.CallStack.HasCallStack, MonadIO m, IsTlsDatabase a, Gio.TlsCertificate.IsTlsCertificate b) =>
    a
    -- ^ /@self@/: a t'GI.Gio.Objects.TlsDatabase.TlsDatabase'
    -> b
    -- ^ /@certificate@/: certificate for which to create a handle.
    -> m (Maybe T.Text)
    -- ^ __Returns:__ a newly allocated string containing the
    -- handle.
tlsDatabaseCreateCertificateHandle :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsTlsDatabase a, IsTlsCertificate b) =>
a -> b -> m (Maybe Text)
tlsDatabaseCreateCertificateHandle a
self b
certificate = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr TlsDatabase)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    certificate' <- unsafeManagedPtrCastPtr certificate
    result <- g_tls_database_create_certificate_handle self' certificate'
    maybeResult <- convertIfNonNull result $ \CString
result' -> do
        result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        freeMem result'
        return result''
    touchManagedPtr self
    touchManagedPtr certificate
    return maybeResult

#if defined(ENABLE_OVERLOADING)
data TlsDatabaseCreateCertificateHandleMethodInfo
instance (signature ~ (b -> m (Maybe T.Text)), MonadIO m, IsTlsDatabase a, Gio.TlsCertificate.IsTlsCertificate b) => O.OverloadedMethod TlsDatabaseCreateCertificateHandleMethodInfo a signature where
    overloadedMethod = tlsDatabaseCreateCertificateHandle

instance O.OverloadedMethodInfo TlsDatabaseCreateCertificateHandleMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.TlsDatabase.tlsDatabaseCreateCertificateHandle",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-TlsDatabase.html#v:tlsDatabaseCreateCertificateHandle"
        })


#endif

-- method TlsDatabase::lookup_certificate_for_handle
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "TlsDatabase" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GTlsDatabase" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "handle"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a certificate handle"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "interaction"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "TlsInteraction" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "used to interact with the user if necessary"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "Gio" , name = "TlsDatabaseLookupFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Flags which affect the lookup."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gio" , name = "TlsCertificate" })
-- throws : True
-- Skip return : False

foreign import ccall "g_tls_database_lookup_certificate_for_handle" g_tls_database_lookup_certificate_for_handle :: 
    Ptr TlsDatabase ->                      -- self : TInterface (Name {namespace = "Gio", name = "TlsDatabase"})
    CString ->                              -- handle : TBasicType TUTF8
    Ptr Gio.TlsInteraction.TlsInteraction -> -- interaction : TInterface (Name {namespace = "Gio", name = "TlsInteraction"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "TlsDatabaseLookupFlags"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.TlsCertificate.TlsCertificate)

-- | Look up a certificate by its handle.
-- 
-- The handle should have been created by calling
-- 'GI.Gio.Objects.TlsDatabase.tlsDatabaseCreateCertificateHandle' on a t'GI.Gio.Objects.TlsDatabase.TlsDatabase' object of
-- the same TLS backend. The handle is designed to remain valid across
-- instantiations of the database.
-- 
-- If the handle is no longer valid, or does not point to a certificate in
-- this database, then 'P.Nothing' will be returned.
-- 
-- This function can block, use 'GI.Gio.Objects.TlsDatabase.tlsDatabaseLookupCertificateForHandleAsync' to perform
-- the lookup operation asynchronously.
-- 
-- /Since: 2.30/
tlsDatabaseLookupCertificateForHandle ::
    (B.CallStack.HasCallStack, MonadIO m, IsTlsDatabase a, Gio.TlsInteraction.IsTlsInteraction b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@self@/: a t'GI.Gio.Objects.TlsDatabase.TlsDatabase'
    -> T.Text
    -- ^ /@handle@/: a certificate handle
    -> Maybe (b)
    -- ^ /@interaction@/: used to interact with the user if necessary
    -> Gio.Enums.TlsDatabaseLookupFlags
    -- ^ /@flags@/: Flags which affect the lookup.
    -> Maybe (c)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> m (Maybe Gio.TlsCertificate.TlsCertificate)
    -- ^ __Returns:__ a newly allocated
    -- t'GI.Gio.Objects.TlsCertificate.TlsCertificate', or 'P.Nothing'. Use 'GI.GObject.Objects.Object.objectUnref' to release the certificate. /(Can throw 'Data.GI.Base.GError.GError')/
tlsDatabaseLookupCertificateForHandle :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsTlsDatabase a, IsTlsInteraction b,
 IsCancellable c) =>
a
-> Text
-> Maybe b
-> TlsDatabaseLookupFlags
-> Maybe c
-> m (Maybe TlsCertificate)
tlsDatabaseLookupCertificateForHandle a
self Text
handle Maybe b
interaction TlsDatabaseLookupFlags
flags Maybe c
cancellable = IO (Maybe TlsCertificate) -> m (Maybe TlsCertificate)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe TlsCertificate) -> m (Maybe TlsCertificate))
-> IO (Maybe TlsCertificate) -> m (Maybe TlsCertificate)
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr TlsDatabase)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    handle' <- textToCString handle
    maybeInteraction <- case interaction of
        Maybe b
Nothing -> Ptr TlsInteraction -> IO (Ptr TlsInteraction)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TlsInteraction
forall a. Ptr a
FP.nullPtr
        Just b
jInteraction -> do
            jInteraction' <- b -> IO (Ptr TlsInteraction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jInteraction
            return jInteraction'
    let flags' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (TlsDatabaseLookupFlags -> Int)
-> TlsDatabaseLookupFlags
-> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TlsDatabaseLookupFlags -> Int
forall a. Enum a => a -> Int
fromEnum) TlsDatabaseLookupFlags
flags
    maybeCancellable <- case cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just c
jCancellable -> do
            jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            return jCancellable'
    onException (do
        result <- propagateGError $ g_tls_database_lookup_certificate_for_handle self' handle' maybeInteraction flags' maybeCancellable
        maybeResult <- convertIfNonNull result $ \Ptr TlsCertificate
result' -> do
            result'' <- ((ManagedPtr TlsCertificate -> TlsCertificate)
-> Ptr TlsCertificate -> IO TlsCertificate
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr TlsCertificate -> TlsCertificate
Gio.TlsCertificate.TlsCertificate) Ptr TlsCertificate
result'
            return result''
        touchManagedPtr self
        whenJust interaction touchManagedPtr
        whenJust cancellable touchManagedPtr
        freeMem handle'
        return maybeResult
     ) (do
        freeMem handle'
     )

#if defined(ENABLE_OVERLOADING)
data TlsDatabaseLookupCertificateForHandleMethodInfo
instance (signature ~ (T.Text -> Maybe (b) -> Gio.Enums.TlsDatabaseLookupFlags -> Maybe (c) -> m (Maybe Gio.TlsCertificate.TlsCertificate)), MonadIO m, IsTlsDatabase a, Gio.TlsInteraction.IsTlsInteraction b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod TlsDatabaseLookupCertificateForHandleMethodInfo a signature where
    overloadedMethod = tlsDatabaseLookupCertificateForHandle

instance O.OverloadedMethodInfo TlsDatabaseLookupCertificateForHandleMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.TlsDatabase.tlsDatabaseLookupCertificateForHandle",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-TlsDatabase.html#v:tlsDatabaseLookupCertificateForHandle"
        })


#endif

-- method TlsDatabase::lookup_certificate_for_handle_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "TlsDatabase" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GTlsDatabase" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "handle"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a certificate handle"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "interaction"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "TlsInteraction" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "used to interact with the user if necessary"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "Gio" , name = "TlsDatabaseLookupFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Flags which affect the lookup."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "callback to call when the operation completes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 6
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to pass to the callback function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_tls_database_lookup_certificate_for_handle_async" g_tls_database_lookup_certificate_for_handle_async :: 
    Ptr TlsDatabase ->                      -- self : TInterface (Name {namespace = "Gio", name = "TlsDatabase"})
    CString ->                              -- handle : TBasicType TUTF8
    Ptr Gio.TlsInteraction.TlsInteraction -> -- interaction : TInterface (Name {namespace = "Gio", name = "TlsInteraction"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "TlsDatabaseLookupFlags"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Asynchronously look up a certificate by its handle in the database. See
-- 'GI.Gio.Objects.TlsDatabase.tlsDatabaseLookupCertificateForHandle' for more information.
-- 
-- /Since: 2.30/
tlsDatabaseLookupCertificateForHandleAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsTlsDatabase a, Gio.TlsInteraction.IsTlsInteraction b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@self@/: a t'GI.Gio.Objects.TlsDatabase.TlsDatabase'
    -> T.Text
    -- ^ /@handle@/: a certificate handle
    -> Maybe (b)
    -- ^ /@interaction@/: used to interact with the user if necessary
    -> Gio.Enums.TlsDatabaseLookupFlags
    -- ^ /@flags@/: Flags which affect the lookup.
    -> Maybe (c)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: callback to call when the operation completes
    -> m ()
tlsDatabaseLookupCertificateForHandleAsync :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsTlsDatabase a, IsTlsInteraction b,
 IsCancellable c) =>
a
-> Text
-> Maybe b
-> TlsDatabaseLookupFlags
-> Maybe c
-> Maybe AsyncReadyCallback
-> m ()
tlsDatabaseLookupCertificateForHandleAsync a
self Text
handle Maybe b
interaction TlsDatabaseLookupFlags
flags Maybe c
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr TlsDatabase)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    handle' <- textToCString handle
    maybeInteraction <- case interaction of
        Maybe b
Nothing -> Ptr TlsInteraction -> IO (Ptr TlsInteraction)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TlsInteraction
forall a. Ptr a
FP.nullPtr
        Just b
jInteraction -> do
            jInteraction' <- b -> IO (Ptr TlsInteraction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jInteraction
            return jInteraction'
    let flags' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (TlsDatabaseLookupFlags -> Int)
-> TlsDatabaseLookupFlags
-> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TlsDatabaseLookupFlags -> Int
forall a. Enum a => a -> Int
fromEnum) TlsDatabaseLookupFlags
flags
    maybeCancellable <- case cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just c
jCancellable -> do
            jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            return jCancellable'
    maybeCallback <- case callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            jCallback' <- Gio.Callbacks.mk_AsyncReadyCallback (Gio.Callbacks.wrap_AsyncReadyCallback (Just ptrcallback) (Gio.Callbacks.drop_closures_AsyncReadyCallback jCallback))
            poke ptrcallback jCallback'
            return jCallback'
    let userData = Ptr a
forall a. Ptr a
nullPtr
    g_tls_database_lookup_certificate_for_handle_async self' handle' maybeInteraction flags' maybeCancellable maybeCallback userData
    touchManagedPtr self
    whenJust interaction touchManagedPtr
    whenJust cancellable touchManagedPtr
    freeMem handle'
    return ()

#if defined(ENABLE_OVERLOADING)
data TlsDatabaseLookupCertificateForHandleAsyncMethodInfo
instance (signature ~ (T.Text -> Maybe (b) -> Gio.Enums.TlsDatabaseLookupFlags -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsTlsDatabase a, Gio.TlsInteraction.IsTlsInteraction b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod TlsDatabaseLookupCertificateForHandleAsyncMethodInfo a signature where
    overloadedMethod = tlsDatabaseLookupCertificateForHandleAsync

instance O.OverloadedMethodInfo TlsDatabaseLookupCertificateForHandleAsyncMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.TlsDatabase.tlsDatabaseLookupCertificateForHandleAsync",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-TlsDatabase.html#v:tlsDatabaseLookupCertificateForHandleAsync"
        })


#endif

-- method TlsDatabase::lookup_certificate_for_handle_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "TlsDatabase" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GTlsDatabase" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAsyncResult." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gio" , name = "TlsCertificate" })
-- throws : True
-- Skip return : False

foreign import ccall "g_tls_database_lookup_certificate_for_handle_finish" g_tls_database_lookup_certificate_for_handle_finish :: 
    Ptr TlsDatabase ->                      -- self : TInterface (Name {namespace = "Gio", name = "TlsDatabase"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.TlsCertificate.TlsCertificate)

-- | Finish an asynchronous lookup of a certificate by its handle. See
-- 'GI.Gio.Objects.TlsDatabase.tlsDatabaseLookupCertificateForHandle' for more information.
-- 
-- If the handle is no longer valid, or does not point to a certificate in
-- this database, then 'P.Nothing' will be returned.
-- 
-- /Since: 2.30/
tlsDatabaseLookupCertificateForHandleFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsTlsDatabase a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@self@/: a t'GI.Gio.Objects.TlsDatabase.TlsDatabase'
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'.
    -> m Gio.TlsCertificate.TlsCertificate
    -- ^ __Returns:__ a newly allocated t'GI.Gio.Objects.TlsCertificate.TlsCertificate' object.
    -- Use 'GI.GObject.Objects.Object.objectUnref' to release the certificate. /(Can throw 'Data.GI.Base.GError.GError')/
tlsDatabaseLookupCertificateForHandleFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsTlsDatabase a, IsAsyncResult b) =>
a -> b -> m TlsCertificate
tlsDatabaseLookupCertificateForHandleFinish a
self b
result_ = IO TlsCertificate -> m TlsCertificate
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TlsCertificate -> m TlsCertificate)
-> IO TlsCertificate -> m TlsCertificate
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr TlsDatabase)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result_' <- unsafeManagedPtrCastPtr result_
    onException (do
        result <- propagateGError $ g_tls_database_lookup_certificate_for_handle_finish self' result_'
        checkUnexpectedReturnNULL "tlsDatabaseLookupCertificateForHandleFinish" result
        result' <- (wrapObject Gio.TlsCertificate.TlsCertificate) result
        touchManagedPtr self
        touchManagedPtr result_
        return result'
     ) (do
        return ()
     )

#if defined(ENABLE_OVERLOADING)
data TlsDatabaseLookupCertificateForHandleFinishMethodInfo
instance (signature ~ (b -> m Gio.TlsCertificate.TlsCertificate), MonadIO m, IsTlsDatabase a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod TlsDatabaseLookupCertificateForHandleFinishMethodInfo a signature where
    overloadedMethod = tlsDatabaseLookupCertificateForHandleFinish

instance O.OverloadedMethodInfo TlsDatabaseLookupCertificateForHandleFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.TlsDatabase.tlsDatabaseLookupCertificateForHandleFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-TlsDatabase.html#v:tlsDatabaseLookupCertificateForHandleFinish"
        })


#endif

-- method TlsDatabase::lookup_certificate_issuer
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "TlsDatabase" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GTlsDatabase" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "certificate"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "TlsCertificate" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GTlsCertificate" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "interaction"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "TlsInteraction" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "used to interact with the user if necessary"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "Gio" , name = "TlsDatabaseLookupFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "flags which affect the lookup operation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gio" , name = "TlsCertificate" })
-- throws : True
-- Skip return : False

foreign import ccall "g_tls_database_lookup_certificate_issuer" g_tls_database_lookup_certificate_issuer :: 
    Ptr TlsDatabase ->                      -- self : TInterface (Name {namespace = "Gio", name = "TlsDatabase"})
    Ptr Gio.TlsCertificate.TlsCertificate -> -- certificate : TInterface (Name {namespace = "Gio", name = "TlsCertificate"})
    Ptr Gio.TlsInteraction.TlsInteraction -> -- interaction : TInterface (Name {namespace = "Gio", name = "TlsInteraction"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "TlsDatabaseLookupFlags"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.TlsCertificate.TlsCertificate)

-- | Look up the issuer of /@certificate@/ in the database. The
-- [TlsCertificate:issuer]("GI.Gio.Objects.TlsCertificate#g:attr:issuer") property of /@certificate@/ is not modified, and
-- the two certificates are not hooked into a chain.
-- 
-- This function can block. Use 'GI.Gio.Objects.TlsDatabase.tlsDatabaseLookupCertificateIssuerAsync'
-- to perform the lookup operation asynchronously.
-- 
-- Beware this function cannot be used to build certification paths. The
-- issuer certificate returned by this function may not be the same as
-- the certificate that would actually be used to construct a valid
-- certification path during certificate verification.
-- <https://datatracker.ietf.org/doc/html/rfc4158 RFC 4158> explains
-- why an issuer certificate cannot be naively assumed to be part of the
-- the certification path (though GLib\'s TLS backends may not follow the
-- path building strategies outlined in this RFC). Due to the complexity
-- of certification path building, GLib does not provide any way to know
-- which certification path will actually be used when verifying a TLS
-- certificate. Accordingly, this function cannot be used to make
-- security-related decisions. Only GLib itself should make security
-- decisions about TLS certificates.
-- 
-- /Since: 2.30/
tlsDatabaseLookupCertificateIssuer ::
    (B.CallStack.HasCallStack, MonadIO m, IsTlsDatabase a, Gio.TlsCertificate.IsTlsCertificate b, Gio.TlsInteraction.IsTlsInteraction c, Gio.Cancellable.IsCancellable d) =>
    a
    -- ^ /@self@/: a t'GI.Gio.Objects.TlsDatabase.TlsDatabase'
    -> b
    -- ^ /@certificate@/: a t'GI.Gio.Objects.TlsCertificate.TlsCertificate'
    -> Maybe (c)
    -- ^ /@interaction@/: used to interact with the user if necessary
    -> Gio.Enums.TlsDatabaseLookupFlags
    -- ^ /@flags@/: flags which affect the lookup operation
    -> Maybe (d)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> m Gio.TlsCertificate.TlsCertificate
    -- ^ __Returns:__ a newly allocated issuer t'GI.Gio.Objects.TlsCertificate.TlsCertificate',
    -- or 'P.Nothing'. Use 'GI.GObject.Objects.Object.objectUnref' to release the certificate. /(Can throw 'Data.GI.Base.GError.GError')/
tlsDatabaseLookupCertificateIssuer :: forall (m :: * -> *) a b c d.
(HasCallStack, MonadIO m, IsTlsDatabase a, IsTlsCertificate b,
 IsTlsInteraction c, IsCancellable d) =>
a
-> b
-> Maybe c
-> TlsDatabaseLookupFlags
-> Maybe d
-> m TlsCertificate
tlsDatabaseLookupCertificateIssuer a
self b
certificate Maybe c
interaction TlsDatabaseLookupFlags
flags Maybe d
cancellable = IO TlsCertificate -> m TlsCertificate
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TlsCertificate -> m TlsCertificate)
-> IO TlsCertificate -> m TlsCertificate
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr TlsDatabase)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    certificate' <- unsafeManagedPtrCastPtr certificate
    maybeInteraction <- case interaction of
        Maybe c
Nothing -> Ptr TlsInteraction -> IO (Ptr TlsInteraction)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TlsInteraction
forall a. Ptr a
FP.nullPtr
        Just c
jInteraction -> do
            jInteraction' <- c -> IO (Ptr TlsInteraction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jInteraction
            return jInteraction'
    let flags' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (TlsDatabaseLookupFlags -> Int)
-> TlsDatabaseLookupFlags
-> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TlsDatabaseLookupFlags -> Int
forall a. Enum a => a -> Int
fromEnum) TlsDatabaseLookupFlags
flags
    maybeCancellable <- case cancellable of
        Maybe d
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just d
jCancellable -> do
            jCancellable' <- d -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr d
jCancellable
            return jCancellable'
    onException (do
        result <- propagateGError $ g_tls_database_lookup_certificate_issuer self' certificate' maybeInteraction flags' maybeCancellable
        checkUnexpectedReturnNULL "tlsDatabaseLookupCertificateIssuer" result
        result' <- (wrapObject Gio.TlsCertificate.TlsCertificate) result
        touchManagedPtr self
        touchManagedPtr certificate
        whenJust interaction touchManagedPtr
        whenJust cancellable touchManagedPtr
        return result'
     ) (do
        return ()
     )

#if defined(ENABLE_OVERLOADING)
data TlsDatabaseLookupCertificateIssuerMethodInfo
instance (signature ~ (b -> Maybe (c) -> Gio.Enums.TlsDatabaseLookupFlags -> Maybe (d) -> m Gio.TlsCertificate.TlsCertificate), MonadIO m, IsTlsDatabase a, Gio.TlsCertificate.IsTlsCertificate b, Gio.TlsInteraction.IsTlsInteraction c, Gio.Cancellable.IsCancellable d) => O.OverloadedMethod TlsDatabaseLookupCertificateIssuerMethodInfo a signature where
    overloadedMethod = tlsDatabaseLookupCertificateIssuer

instance O.OverloadedMethodInfo TlsDatabaseLookupCertificateIssuerMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.TlsDatabase.tlsDatabaseLookupCertificateIssuer",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-TlsDatabase.html#v:tlsDatabaseLookupCertificateIssuer"
        })


#endif

-- method TlsDatabase::lookup_certificate_issuer_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "TlsDatabase" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GTlsDatabase" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "certificate"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "TlsCertificate" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GTlsCertificate" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "interaction"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "TlsInteraction" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "used to interact with the user if necessary"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "Gio" , name = "TlsDatabaseLookupFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "flags which affect the lookup operation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "callback to call when the operation completes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 6
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to pass to the callback function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_tls_database_lookup_certificate_issuer_async" g_tls_database_lookup_certificate_issuer_async :: 
    Ptr TlsDatabase ->                      -- self : TInterface (Name {namespace = "Gio", name = "TlsDatabase"})
    Ptr Gio.TlsCertificate.TlsCertificate -> -- certificate : TInterface (Name {namespace = "Gio", name = "TlsCertificate"})
    Ptr Gio.TlsInteraction.TlsInteraction -> -- interaction : TInterface (Name {namespace = "Gio", name = "TlsInteraction"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "TlsDatabaseLookupFlags"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Asynchronously look up the issuer of /@certificate@/ in the database. See
-- 'GI.Gio.Objects.TlsDatabase.tlsDatabaseLookupCertificateIssuer' for more information.
-- 
-- /Since: 2.30/
tlsDatabaseLookupCertificateIssuerAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsTlsDatabase a, Gio.TlsCertificate.IsTlsCertificate b, Gio.TlsInteraction.IsTlsInteraction c, Gio.Cancellable.IsCancellable d) =>
    a
    -- ^ /@self@/: a t'GI.Gio.Objects.TlsDatabase.TlsDatabase'
    -> b
    -- ^ /@certificate@/: a t'GI.Gio.Objects.TlsCertificate.TlsCertificate'
    -> Maybe (c)
    -- ^ /@interaction@/: used to interact with the user if necessary
    -> Gio.Enums.TlsDatabaseLookupFlags
    -- ^ /@flags@/: flags which affect the lookup operation
    -> Maybe (d)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: callback to call when the operation completes
    -> m ()
tlsDatabaseLookupCertificateIssuerAsync :: forall (m :: * -> *) a b c d.
(HasCallStack, MonadIO m, IsTlsDatabase a, IsTlsCertificate b,
 IsTlsInteraction c, IsCancellable d) =>
a
-> b
-> Maybe c
-> TlsDatabaseLookupFlags
-> Maybe d
-> Maybe AsyncReadyCallback
-> m ()
tlsDatabaseLookupCertificateIssuerAsync a
self b
certificate Maybe c
interaction TlsDatabaseLookupFlags
flags Maybe d
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr TlsDatabase)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    certificate' <- unsafeManagedPtrCastPtr certificate
    maybeInteraction <- case interaction of
        Maybe c
Nothing -> Ptr TlsInteraction -> IO (Ptr TlsInteraction)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TlsInteraction
forall a. Ptr a
FP.nullPtr
        Just c
jInteraction -> do
            jInteraction' <- c -> IO (Ptr TlsInteraction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jInteraction
            return jInteraction'
    let flags' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (TlsDatabaseLookupFlags -> Int)
-> TlsDatabaseLookupFlags
-> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TlsDatabaseLookupFlags -> Int
forall a. Enum a => a -> Int
fromEnum) TlsDatabaseLookupFlags
flags
    maybeCancellable <- case cancellable of
        Maybe d
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just d
jCancellable -> do
            jCancellable' <- d -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr d
jCancellable
            return jCancellable'
    maybeCallback <- case callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            jCallback' <- Gio.Callbacks.mk_AsyncReadyCallback (Gio.Callbacks.wrap_AsyncReadyCallback (Just ptrcallback) (Gio.Callbacks.drop_closures_AsyncReadyCallback jCallback))
            poke ptrcallback jCallback'
            return jCallback'
    let userData = Ptr a
forall a. Ptr a
nullPtr
    g_tls_database_lookup_certificate_issuer_async self' certificate' maybeInteraction flags' maybeCancellable maybeCallback userData
    touchManagedPtr self
    touchManagedPtr certificate
    whenJust interaction touchManagedPtr
    whenJust cancellable touchManagedPtr
    return ()

#if defined(ENABLE_OVERLOADING)
data TlsDatabaseLookupCertificateIssuerAsyncMethodInfo
instance (signature ~ (b -> Maybe (c) -> Gio.Enums.TlsDatabaseLookupFlags -> Maybe (d) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsTlsDatabase a, Gio.TlsCertificate.IsTlsCertificate b, Gio.TlsInteraction.IsTlsInteraction c, Gio.Cancellable.IsCancellable d) => O.OverloadedMethod TlsDatabaseLookupCertificateIssuerAsyncMethodInfo a signature where
    overloadedMethod = tlsDatabaseLookupCertificateIssuerAsync

instance O.OverloadedMethodInfo TlsDatabaseLookupCertificateIssuerAsyncMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.TlsDatabase.tlsDatabaseLookupCertificateIssuerAsync",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-TlsDatabase.html#v:tlsDatabaseLookupCertificateIssuerAsync"
        })


#endif

-- method TlsDatabase::lookup_certificate_issuer_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "TlsDatabase" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GTlsDatabase" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAsyncResult." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gio" , name = "TlsCertificate" })
-- throws : True
-- Skip return : False

foreign import ccall "g_tls_database_lookup_certificate_issuer_finish" g_tls_database_lookup_certificate_issuer_finish :: 
    Ptr TlsDatabase ->                      -- self : TInterface (Name {namespace = "Gio", name = "TlsDatabase"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.TlsCertificate.TlsCertificate)

-- | Finish an asynchronous lookup issuer operation. See
-- 'GI.Gio.Objects.TlsDatabase.tlsDatabaseLookupCertificateIssuer' for more information.
-- 
-- /Since: 2.30/
tlsDatabaseLookupCertificateIssuerFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsTlsDatabase a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@self@/: a t'GI.Gio.Objects.TlsDatabase.TlsDatabase'
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'.
    -> m Gio.TlsCertificate.TlsCertificate
    -- ^ __Returns:__ a newly allocated issuer t'GI.Gio.Objects.TlsCertificate.TlsCertificate',
    -- or 'P.Nothing'. Use 'GI.GObject.Objects.Object.objectUnref' to release the certificate. /(Can throw 'Data.GI.Base.GError.GError')/
tlsDatabaseLookupCertificateIssuerFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsTlsDatabase a, IsAsyncResult b) =>
a -> b -> m TlsCertificate
tlsDatabaseLookupCertificateIssuerFinish a
self b
result_ = IO TlsCertificate -> m TlsCertificate
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TlsCertificate -> m TlsCertificate)
-> IO TlsCertificate -> m TlsCertificate
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr TlsDatabase)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result_' <- unsafeManagedPtrCastPtr result_
    onException (do
        result <- propagateGError $ g_tls_database_lookup_certificate_issuer_finish self' result_'
        checkUnexpectedReturnNULL "tlsDatabaseLookupCertificateIssuerFinish" result
        result' <- (wrapObject Gio.TlsCertificate.TlsCertificate) result
        touchManagedPtr self
        touchManagedPtr result_
        return result'
     ) (do
        return ()
     )

#if defined(ENABLE_OVERLOADING)
data TlsDatabaseLookupCertificateIssuerFinishMethodInfo
instance (signature ~ (b -> m Gio.TlsCertificate.TlsCertificate), MonadIO m, IsTlsDatabase a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod TlsDatabaseLookupCertificateIssuerFinishMethodInfo a signature where
    overloadedMethod = tlsDatabaseLookupCertificateIssuerFinish

instance O.OverloadedMethodInfo TlsDatabaseLookupCertificateIssuerFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.TlsDatabase.tlsDatabaseLookupCertificateIssuerFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-TlsDatabase.html#v:tlsDatabaseLookupCertificateIssuerFinish"
        })


#endif

-- method TlsDatabase::lookup_certificates_issued_by
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "TlsDatabase" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GTlsDatabase" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "issuer_raw_dn"
--           , argType = TByteArray
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GByteArray which holds the DER encoded issuer DN."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "interaction"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "TlsInteraction" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "used to interact with the user if necessary"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "Gio" , name = "TlsDatabaseLookupFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Flags which affect the lookup operation."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList
--                  (TInterface Name { namespace = "Gio" , name = "TlsCertificate" }))
-- throws : True
-- Skip return : False

foreign import ccall "g_tls_database_lookup_certificates_issued_by" g_tls_database_lookup_certificates_issued_by :: 
    Ptr TlsDatabase ->                      -- self : TInterface (Name {namespace = "Gio", name = "TlsDatabase"})
    Ptr GByteArray ->                       -- issuer_raw_dn : TByteArray
    Ptr Gio.TlsInteraction.TlsInteraction -> -- interaction : TInterface (Name {namespace = "Gio", name = "TlsInteraction"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "TlsDatabaseLookupFlags"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr (GList (Ptr Gio.TlsCertificate.TlsCertificate)))

-- | Look up certificates issued by this issuer in the database.
-- 
-- This function can block, use 'GI.Gio.Objects.TlsDatabase.tlsDatabaseLookupCertificatesIssuedByAsync' to perform
-- the lookup operation asynchronously.
-- 
-- /Since: 2.30/
tlsDatabaseLookupCertificatesIssuedBy ::
    (B.CallStack.HasCallStack, MonadIO m, IsTlsDatabase a, Gio.TlsInteraction.IsTlsInteraction b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@self@/: a t'GI.Gio.Objects.TlsDatabase.TlsDatabase'
    -> ByteString
    -- ^ /@issuerRawDn@/: a t'GI.GLib.Structs.ByteArray.ByteArray' which holds the DER encoded issuer DN.
    -> Maybe (b)
    -- ^ /@interaction@/: used to interact with the user if necessary
    -> Gio.Enums.TlsDatabaseLookupFlags
    -- ^ /@flags@/: Flags which affect the lookup operation.
    -> Maybe (c)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> m [Gio.TlsCertificate.TlsCertificate]
    -- ^ __Returns:__ a newly allocated list of t'GI.Gio.Objects.TlsCertificate.TlsCertificate'
    -- objects. Use 'GI.GObject.Objects.Object.objectUnref' on each certificate, and @/g_list_free()/@ on the release the list. /(Can throw 'Data.GI.Base.GError.GError')/
tlsDatabaseLookupCertificatesIssuedBy :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsTlsDatabase a, IsTlsInteraction b,
 IsCancellable c) =>
a
-> ByteString
-> Maybe b
-> TlsDatabaseLookupFlags
-> Maybe c
-> m [TlsCertificate]
tlsDatabaseLookupCertificatesIssuedBy a
self ByteString
issuerRawDn Maybe b
interaction TlsDatabaseLookupFlags
flags Maybe c
cancellable = IO [TlsCertificate] -> m [TlsCertificate]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [TlsCertificate] -> m [TlsCertificate])
-> IO [TlsCertificate] -> m [TlsCertificate]
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr TlsDatabase)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    issuerRawDn' <- packGByteArray issuerRawDn
    maybeInteraction <- case interaction of
        Maybe b
Nothing -> Ptr TlsInteraction -> IO (Ptr TlsInteraction)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TlsInteraction
forall a. Ptr a
FP.nullPtr
        Just b
jInteraction -> do
            jInteraction' <- b -> IO (Ptr TlsInteraction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jInteraction
            return jInteraction'
    let flags' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (TlsDatabaseLookupFlags -> Int)
-> TlsDatabaseLookupFlags
-> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TlsDatabaseLookupFlags -> Int
forall a. Enum a => a -> Int
fromEnum) TlsDatabaseLookupFlags
flags
    maybeCancellable <- case cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just c
jCancellable -> do
            jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            return jCancellable'
    onException (do
        result <- propagateGError $ g_tls_database_lookup_certificates_issued_by self' issuerRawDn' maybeInteraction flags' maybeCancellable
        result' <- unpackGList result
        result'' <- mapM (wrapObject Gio.TlsCertificate.TlsCertificate) result'
        g_list_free result
        touchManagedPtr self
        whenJust interaction touchManagedPtr
        whenJust cancellable touchManagedPtr
        unrefGByteArray issuerRawDn'
        return result''
     ) (do
        unrefGByteArray issuerRawDn'
     )

#if defined(ENABLE_OVERLOADING)
data TlsDatabaseLookupCertificatesIssuedByMethodInfo
instance (signature ~ (ByteString -> Maybe (b) -> Gio.Enums.TlsDatabaseLookupFlags -> Maybe (c) -> m [Gio.TlsCertificate.TlsCertificate]), MonadIO m, IsTlsDatabase a, Gio.TlsInteraction.IsTlsInteraction b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod TlsDatabaseLookupCertificatesIssuedByMethodInfo a signature where
    overloadedMethod = tlsDatabaseLookupCertificatesIssuedBy

instance O.OverloadedMethodInfo TlsDatabaseLookupCertificatesIssuedByMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.TlsDatabase.tlsDatabaseLookupCertificatesIssuedBy",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-TlsDatabase.html#v:tlsDatabaseLookupCertificatesIssuedBy"
        })


#endif

-- method TlsDatabase::lookup_certificates_issued_by_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "TlsDatabase" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GTlsDatabase" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "issuer_raw_dn"
--           , argType = TByteArray
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GByteArray which holds the DER encoded issuer DN."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "interaction"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "TlsInteraction" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "used to interact with the user if necessary"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "Gio" , name = "TlsDatabaseLookupFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Flags which affect the lookup operation."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "callback to call when the operation completes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 6
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to pass to the callback function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_tls_database_lookup_certificates_issued_by_async" g_tls_database_lookup_certificates_issued_by_async :: 
    Ptr TlsDatabase ->                      -- self : TInterface (Name {namespace = "Gio", name = "TlsDatabase"})
    Ptr GByteArray ->                       -- issuer_raw_dn : TByteArray
    Ptr Gio.TlsInteraction.TlsInteraction -> -- interaction : TInterface (Name {namespace = "Gio", name = "TlsInteraction"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "TlsDatabaseLookupFlags"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Asynchronously look up certificates issued by this issuer in the database. See
-- 'GI.Gio.Objects.TlsDatabase.tlsDatabaseLookupCertificatesIssuedBy' for more information.
-- 
-- The database may choose to hold a reference to the issuer byte array for the duration
-- of this asynchronous operation. The byte array should not be modified during
-- this time.
-- 
-- /Since: 2.30/
tlsDatabaseLookupCertificatesIssuedByAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsTlsDatabase a, Gio.TlsInteraction.IsTlsInteraction b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@self@/: a t'GI.Gio.Objects.TlsDatabase.TlsDatabase'
    -> ByteString
    -- ^ /@issuerRawDn@/: a t'GI.GLib.Structs.ByteArray.ByteArray' which holds the DER encoded issuer DN.
    -> Maybe (b)
    -- ^ /@interaction@/: used to interact with the user if necessary
    -> Gio.Enums.TlsDatabaseLookupFlags
    -- ^ /@flags@/: Flags which affect the lookup operation.
    -> Maybe (c)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: callback to call when the operation completes
    -> m ()
tlsDatabaseLookupCertificatesIssuedByAsync :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsTlsDatabase a, IsTlsInteraction b,
 IsCancellable c) =>
a
-> ByteString
-> Maybe b
-> TlsDatabaseLookupFlags
-> Maybe c
-> Maybe AsyncReadyCallback
-> m ()
tlsDatabaseLookupCertificatesIssuedByAsync a
self ByteString
issuerRawDn Maybe b
interaction TlsDatabaseLookupFlags
flags Maybe c
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr TlsDatabase)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    issuerRawDn' <- packGByteArray issuerRawDn
    maybeInteraction <- case interaction of
        Maybe b
Nothing -> Ptr TlsInteraction -> IO (Ptr TlsInteraction)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TlsInteraction
forall a. Ptr a
FP.nullPtr
        Just b
jInteraction -> do
            jInteraction' <- b -> IO (Ptr TlsInteraction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jInteraction
            return jInteraction'
    let flags' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (TlsDatabaseLookupFlags -> Int)
-> TlsDatabaseLookupFlags
-> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TlsDatabaseLookupFlags -> Int
forall a. Enum a => a -> Int
fromEnum) TlsDatabaseLookupFlags
flags
    maybeCancellable <- case cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just c
jCancellable -> do
            jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            return jCancellable'
    maybeCallback <- case callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            jCallback' <- Gio.Callbacks.mk_AsyncReadyCallback (Gio.Callbacks.wrap_AsyncReadyCallback (Just ptrcallback) (Gio.Callbacks.drop_closures_AsyncReadyCallback jCallback))
            poke ptrcallback jCallback'
            return jCallback'
    let userData = Ptr a
forall a. Ptr a
nullPtr
    g_tls_database_lookup_certificates_issued_by_async self' issuerRawDn' maybeInteraction flags' maybeCancellable maybeCallback userData
    touchManagedPtr self
    whenJust interaction touchManagedPtr
    whenJust cancellable touchManagedPtr
    unrefGByteArray issuerRawDn'
    return ()

#if defined(ENABLE_OVERLOADING)
data TlsDatabaseLookupCertificatesIssuedByAsyncMethodInfo
instance (signature ~ (ByteString -> Maybe (b) -> Gio.Enums.TlsDatabaseLookupFlags -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsTlsDatabase a, Gio.TlsInteraction.IsTlsInteraction b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod TlsDatabaseLookupCertificatesIssuedByAsyncMethodInfo a signature where
    overloadedMethod = tlsDatabaseLookupCertificatesIssuedByAsync

instance O.OverloadedMethodInfo TlsDatabaseLookupCertificatesIssuedByAsyncMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.TlsDatabase.tlsDatabaseLookupCertificatesIssuedByAsync",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-TlsDatabase.html#v:tlsDatabaseLookupCertificatesIssuedByAsync"
        })


#endif

-- method TlsDatabase::lookup_certificates_issued_by_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "TlsDatabase" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GTlsDatabase" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAsyncResult." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList
--                  (TInterface Name { namespace = "Gio" , name = "TlsCertificate" }))
-- throws : True
-- Skip return : False

foreign import ccall "g_tls_database_lookup_certificates_issued_by_finish" g_tls_database_lookup_certificates_issued_by_finish :: 
    Ptr TlsDatabase ->                      -- self : TInterface (Name {namespace = "Gio", name = "TlsDatabase"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr (GList (Ptr Gio.TlsCertificate.TlsCertificate)))

-- | Finish an asynchronous lookup of certificates. See
-- 'GI.Gio.Objects.TlsDatabase.tlsDatabaseLookupCertificatesIssuedBy' for more information.
-- 
-- /Since: 2.30/
tlsDatabaseLookupCertificatesIssuedByFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsTlsDatabase a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@self@/: a t'GI.Gio.Objects.TlsDatabase.TlsDatabase'
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'.
    -> m [Gio.TlsCertificate.TlsCertificate]
    -- ^ __Returns:__ a newly allocated list of t'GI.Gio.Objects.TlsCertificate.TlsCertificate'
    -- objects. Use 'GI.GObject.Objects.Object.objectUnref' on each certificate, and @/g_list_free()/@ on the release the list. /(Can throw 'Data.GI.Base.GError.GError')/
tlsDatabaseLookupCertificatesIssuedByFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsTlsDatabase a, IsAsyncResult b) =>
a -> b -> m [TlsCertificate]
tlsDatabaseLookupCertificatesIssuedByFinish a
self b
result_ = IO [TlsCertificate] -> m [TlsCertificate]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [TlsCertificate] -> m [TlsCertificate])
-> IO [TlsCertificate] -> m [TlsCertificate]
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr TlsDatabase)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result_' <- unsafeManagedPtrCastPtr result_
    onException (do
        result <- propagateGError $ g_tls_database_lookup_certificates_issued_by_finish self' result_'
        result' <- unpackGList result
        result'' <- mapM (wrapObject Gio.TlsCertificate.TlsCertificate) result'
        g_list_free result
        touchManagedPtr self
        touchManagedPtr result_
        return result''
     ) (do
        return ()
     )

#if defined(ENABLE_OVERLOADING)
data TlsDatabaseLookupCertificatesIssuedByFinishMethodInfo
instance (signature ~ (b -> m [Gio.TlsCertificate.TlsCertificate]), MonadIO m, IsTlsDatabase a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod TlsDatabaseLookupCertificatesIssuedByFinishMethodInfo a signature where
    overloadedMethod = tlsDatabaseLookupCertificatesIssuedByFinish

instance O.OverloadedMethodInfo TlsDatabaseLookupCertificatesIssuedByFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.TlsDatabase.tlsDatabaseLookupCertificatesIssuedByFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-TlsDatabase.html#v:tlsDatabaseLookupCertificatesIssuedByFinish"
        })


#endif

-- method TlsDatabase::verify_chain
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "TlsDatabase" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GTlsDatabase" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "chain"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "TlsCertificate" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GTlsCertificate chain"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "purpose"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the purpose that this certificate chain will be used for."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "identity"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SocketConnectable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the expected peer identity"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "interaction"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "TlsInteraction" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "used to interact with the user if necessary"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "Gio" , name = "TlsDatabaseVerifyFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "additional verify flags"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Gio" , name = "TlsCertificateFlags" })
-- throws : True
-- Skip return : False

foreign import ccall "g_tls_database_verify_chain" g_tls_database_verify_chain :: 
    Ptr TlsDatabase ->                      -- self : TInterface (Name {namespace = "Gio", name = "TlsDatabase"})
    Ptr Gio.TlsCertificate.TlsCertificate -> -- chain : TInterface (Name {namespace = "Gio", name = "TlsCertificate"})
    CString ->                              -- purpose : TBasicType TUTF8
    Ptr Gio.SocketConnectable.SocketConnectable -> -- identity : TInterface (Name {namespace = "Gio", name = "SocketConnectable"})
    Ptr Gio.TlsInteraction.TlsInteraction -> -- interaction : TInterface (Name {namespace = "Gio", name = "TlsInteraction"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "TlsDatabaseVerifyFlags"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CUInt

-- | Determines the validity of a certificate chain, outside the context
-- of a TLS session.
-- 
-- /@chain@/ is a chain of t'GI.Gio.Objects.TlsCertificate.TlsCertificate' objects each pointing to the next
-- certificate in the chain by its [TlsCertificate:issuer]("GI.Gio.Objects.TlsCertificate#g:attr:issuer") property.
-- 
-- /@purpose@/ describes the purpose (or usage) for which the certificate
-- is being used. Typically /@purpose@/ will be set to 'GI.Gio.Constants.TLS_DATABASE_PURPOSE_AUTHENTICATE_SERVER'
-- which means that the certificate is being used to authenticate a server
-- (and we are acting as the client).
-- 
-- The /@identity@/ is used to ensure the server certificate is valid for
-- the expected peer identity. If the identity does not match the
-- certificate, 'GI.Gio.Flags.TlsCertificateFlagsBadIdentity' will be set in the
-- return value. If /@identity@/ is 'P.Nothing', that bit will never be set in
-- the return value. The peer identity may also be used to check for
-- pinned certificates (trust exceptions) in the database. These may
-- override the normal verification process on a host-by-host basis.
-- 
-- Currently there are no /@flags@/, and 'GI.Gio.Flags.TlsDatabaseVerifyFlagsNone' should be
-- used.
-- 
-- If /@chain@/ is found to be valid, then the return value will be 0. If
-- /@chain@/ is found to be invalid, then the return value will indicate at
-- least one problem found. If the function is unable to determine
-- whether /@chain@/ is valid (for example, because /@cancellable@/ is
-- triggered before it completes) then the return value will be
-- 'GI.Gio.Flags.TlsCertificateFlagsGenericError' and /@error@/ will be set accordingly.
-- /@error@/ is not set when /@chain@/ is successfully analyzed but found to
-- be invalid.
-- 
-- GLib guarantees that if certificate verification fails, at least one
-- error will be set in the return value, but it does not guarantee
-- that all possible errors will be set. Accordingly, you may not safely
-- decide to ignore any particular type of error. For example, it would
-- be incorrect to mask 'GI.Gio.Flags.TlsCertificateFlagsExpired' if you want to allow
-- expired certificates, because this could potentially be the only
-- error flag set even if other problems exist with the certificate.
-- 
-- Prior to GLib 2.48, GLib\'s default TLS backend modified /@chain@/ to
-- represent the certification path built by t'GI.Gio.Objects.TlsDatabase.TlsDatabase' during
-- certificate verification by adjusting the [TlsCertificate:issuer]("GI.Gio.Objects.TlsCertificate#g:attr:issuer")
-- property of each certificate in /@chain@/. Since GLib 2.48, this no
-- longer occurs, so you cannot rely on [TlsCertificate:issuer]("GI.Gio.Objects.TlsCertificate#g:attr:issuer") to
-- represent the actual certification path used during certificate
-- verification.
-- 
-- Because TLS session context is not used, t'GI.Gio.Objects.TlsDatabase.TlsDatabase' may not
-- perform as many checks on the certificates as t'GI.Gio.Objects.TlsConnection.TlsConnection' would.
-- For example, certificate constraints may not be honored, and
-- revocation checks may not be performed. The best way to verify TLS
-- certificates used by a TLS connection is to let t'GI.Gio.Objects.TlsConnection.TlsConnection'
-- handle the verification.
-- 
-- The TLS backend may attempt to look up and add missing certificates
-- to the chain. This may involve HTTP requests to download missing
-- certificates.
-- 
-- This function can block. Use 'GI.Gio.Objects.TlsDatabase.tlsDatabaseVerifyChainAsync' to
-- perform the verification operation asynchronously.
-- 
-- /Since: 2.30/
tlsDatabaseVerifyChain ::
    (B.CallStack.HasCallStack, MonadIO m, IsTlsDatabase a, Gio.TlsCertificate.IsTlsCertificate b, Gio.SocketConnectable.IsSocketConnectable c, Gio.TlsInteraction.IsTlsInteraction d, Gio.Cancellable.IsCancellable e) =>
    a
    -- ^ /@self@/: a t'GI.Gio.Objects.TlsDatabase.TlsDatabase'
    -> b
    -- ^ /@chain@/: a t'GI.Gio.Objects.TlsCertificate.TlsCertificate' chain
    -> T.Text
    -- ^ /@purpose@/: the purpose that this certificate chain will be used for.
    -> Maybe (c)
    -- ^ /@identity@/: the expected peer identity
    -> Maybe (d)
    -- ^ /@interaction@/: used to interact with the user if necessary
    -> [Gio.Flags.TlsDatabaseVerifyFlags]
    -- ^ /@flags@/: additional verify flags
    -> Maybe (e)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> m [Gio.Flags.TlsCertificateFlags]
    -- ^ __Returns:__ the appropriate t'GI.Gio.Flags.TlsCertificateFlags' which represents the
    -- result of verification. /(Can throw 'Data.GI.Base.GError.GError')/
tlsDatabaseVerifyChain :: forall (m :: * -> *) a b c d e.
(HasCallStack, MonadIO m, IsTlsDatabase a, IsTlsCertificate b,
 IsSocketConnectable c, IsTlsInteraction d, IsCancellable e) =>
a
-> b
-> Text
-> Maybe c
-> Maybe d
-> [TlsDatabaseVerifyFlags]
-> Maybe e
-> m [TlsCertificateFlags]
tlsDatabaseVerifyChain a
self b
chain Text
purpose Maybe c
identity Maybe d
interaction [TlsDatabaseVerifyFlags]
flags Maybe e
cancellable = IO [TlsCertificateFlags] -> m [TlsCertificateFlags]
forall a. IO a -> m a
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
    self' <- a -> IO (Ptr TlsDatabase)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    chain' <- unsafeManagedPtrCastPtr chain
    purpose' <- textToCString purpose
    maybeIdentity <- case identity of
        Maybe c
Nothing -> Ptr SocketConnectable -> IO (Ptr SocketConnectable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr SocketConnectable
forall a. Ptr a
FP.nullPtr
        Just c
jIdentity -> do
            jIdentity' <- c -> IO (Ptr SocketConnectable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jIdentity
            return jIdentity'
    maybeInteraction <- case interaction of
        Maybe d
Nothing -> Ptr TlsInteraction -> IO (Ptr TlsInteraction)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TlsInteraction
forall a. Ptr a
FP.nullPtr
        Just d
jInteraction -> do
            jInteraction' <- d -> IO (Ptr TlsInteraction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr d
jInteraction
            return jInteraction'
    let flags' = [TlsDatabaseVerifyFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [TlsDatabaseVerifyFlags]
flags
    maybeCancellable <- case cancellable of
        Maybe e
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just e
jCancellable -> do
            jCancellable' <- e -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr e
jCancellable
            return jCancellable'
    onException (do
        result <- propagateGError $ g_tls_database_verify_chain self' chain' purpose' maybeIdentity maybeInteraction flags' maybeCancellable
        let result' = CUInt -> [TlsCertificateFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
        touchManagedPtr self
        touchManagedPtr chain
        whenJust identity touchManagedPtr
        whenJust interaction touchManagedPtr
        whenJust cancellable touchManagedPtr
        freeMem purpose'
        return result'
     ) (do
        freeMem purpose'
     )

#if defined(ENABLE_OVERLOADING)
data TlsDatabaseVerifyChainMethodInfo
instance (signature ~ (b -> T.Text -> Maybe (c) -> Maybe (d) -> [Gio.Flags.TlsDatabaseVerifyFlags] -> Maybe (e) -> m [Gio.Flags.TlsCertificateFlags]), MonadIO m, IsTlsDatabase a, Gio.TlsCertificate.IsTlsCertificate b, Gio.SocketConnectable.IsSocketConnectable c, Gio.TlsInteraction.IsTlsInteraction d, Gio.Cancellable.IsCancellable e) => O.OverloadedMethod TlsDatabaseVerifyChainMethodInfo a signature where
    overloadedMethod = tlsDatabaseVerifyChain

instance O.OverloadedMethodInfo TlsDatabaseVerifyChainMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.TlsDatabase.tlsDatabaseVerifyChain",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-TlsDatabase.html#v:tlsDatabaseVerifyChain"
        })


#endif

-- method TlsDatabase::verify_chain_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "TlsDatabase" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GTlsDatabase" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "chain"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "TlsCertificate" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GTlsCertificate chain"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "purpose"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the purpose that this certificate chain will be used for."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "identity"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SocketConnectable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the expected peer identity"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "interaction"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "TlsInteraction" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "used to interact with the user if necessary"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "Gio" , name = "TlsDatabaseVerifyFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "additional verify flags"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "callback to call when the operation completes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 8
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to pass to the callback function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_tls_database_verify_chain_async" g_tls_database_verify_chain_async :: 
    Ptr TlsDatabase ->                      -- self : TInterface (Name {namespace = "Gio", name = "TlsDatabase"})
    Ptr Gio.TlsCertificate.TlsCertificate -> -- chain : TInterface (Name {namespace = "Gio", name = "TlsCertificate"})
    CString ->                              -- purpose : TBasicType TUTF8
    Ptr Gio.SocketConnectable.SocketConnectable -> -- identity : TInterface (Name {namespace = "Gio", name = "SocketConnectable"})
    Ptr Gio.TlsInteraction.TlsInteraction -> -- interaction : TInterface (Name {namespace = "Gio", name = "TlsInteraction"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "TlsDatabaseVerifyFlags"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Asynchronously determines the validity of a certificate chain after
-- looking up and adding any missing certificates to the chain. See
-- 'GI.Gio.Objects.TlsDatabase.tlsDatabaseVerifyChain' for more information.
-- 
-- /Since: 2.30/
tlsDatabaseVerifyChainAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsTlsDatabase a, Gio.TlsCertificate.IsTlsCertificate b, Gio.SocketConnectable.IsSocketConnectable c, Gio.TlsInteraction.IsTlsInteraction d, Gio.Cancellable.IsCancellable e) =>
    a
    -- ^ /@self@/: a t'GI.Gio.Objects.TlsDatabase.TlsDatabase'
    -> b
    -- ^ /@chain@/: a t'GI.Gio.Objects.TlsCertificate.TlsCertificate' chain
    -> T.Text
    -- ^ /@purpose@/: the purpose that this certificate chain will be used for.
    -> Maybe (c)
    -- ^ /@identity@/: the expected peer identity
    -> Maybe (d)
    -- ^ /@interaction@/: used to interact with the user if necessary
    -> [Gio.Flags.TlsDatabaseVerifyFlags]
    -- ^ /@flags@/: additional verify flags
    -> Maybe (e)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: callback to call when the operation completes
    -> m ()
tlsDatabaseVerifyChainAsync :: forall (m :: * -> *) a b c d e.
(HasCallStack, MonadIO m, IsTlsDatabase a, IsTlsCertificate b,
 IsSocketConnectable c, IsTlsInteraction d, IsCancellable e) =>
a
-> b
-> Text
-> Maybe c
-> Maybe d
-> [TlsDatabaseVerifyFlags]
-> Maybe e
-> Maybe AsyncReadyCallback
-> m ()
tlsDatabaseVerifyChainAsync a
self b
chain Text
purpose Maybe c
identity Maybe d
interaction [TlsDatabaseVerifyFlags]
flags Maybe e
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr TlsDatabase)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    chain' <- unsafeManagedPtrCastPtr chain
    purpose' <- textToCString purpose
    maybeIdentity <- case identity of
        Maybe c
Nothing -> Ptr SocketConnectable -> IO (Ptr SocketConnectable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr SocketConnectable
forall a. Ptr a
FP.nullPtr
        Just c
jIdentity -> do
            jIdentity' <- c -> IO (Ptr SocketConnectable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jIdentity
            return jIdentity'
    maybeInteraction <- case interaction of
        Maybe d
Nothing -> Ptr TlsInteraction -> IO (Ptr TlsInteraction)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TlsInteraction
forall a. Ptr a
FP.nullPtr
        Just d
jInteraction -> do
            jInteraction' <- d -> IO (Ptr TlsInteraction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr d
jInteraction
            return jInteraction'
    let flags' = [TlsDatabaseVerifyFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [TlsDatabaseVerifyFlags]
flags
    maybeCancellable <- case cancellable of
        Maybe e
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just e
jCancellable -> do
            jCancellable' <- e -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr e
jCancellable
            return jCancellable'
    maybeCallback <- case callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            jCallback' <- Gio.Callbacks.mk_AsyncReadyCallback (Gio.Callbacks.wrap_AsyncReadyCallback (Just ptrcallback) (Gio.Callbacks.drop_closures_AsyncReadyCallback jCallback))
            poke ptrcallback jCallback'
            return jCallback'
    let userData = Ptr a
forall a. Ptr a
nullPtr
    g_tls_database_verify_chain_async self' chain' purpose' maybeIdentity maybeInteraction flags' maybeCancellable maybeCallback userData
    touchManagedPtr self
    touchManagedPtr chain
    whenJust identity touchManagedPtr
    whenJust interaction touchManagedPtr
    whenJust cancellable touchManagedPtr
    freeMem purpose'
    return ()

#if defined(ENABLE_OVERLOADING)
data TlsDatabaseVerifyChainAsyncMethodInfo
instance (signature ~ (b -> T.Text -> Maybe (c) -> Maybe (d) -> [Gio.Flags.TlsDatabaseVerifyFlags] -> Maybe (e) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsTlsDatabase a, Gio.TlsCertificate.IsTlsCertificate b, Gio.SocketConnectable.IsSocketConnectable c, Gio.TlsInteraction.IsTlsInteraction d, Gio.Cancellable.IsCancellable e) => O.OverloadedMethod TlsDatabaseVerifyChainAsyncMethodInfo a signature where
    overloadedMethod = tlsDatabaseVerifyChainAsync

instance O.OverloadedMethodInfo TlsDatabaseVerifyChainAsyncMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.TlsDatabase.tlsDatabaseVerifyChainAsync",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-TlsDatabase.html#v:tlsDatabaseVerifyChainAsync"
        })


#endif

-- method TlsDatabase::verify_chain_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "TlsDatabase" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GTlsDatabase" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAsyncResult." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Gio" , name = "TlsCertificateFlags" })
-- throws : True
-- Skip return : False

foreign import ccall "g_tls_database_verify_chain_finish" g_tls_database_verify_chain_finish :: 
    Ptr TlsDatabase ->                      -- self : TInterface (Name {namespace = "Gio", name = "TlsDatabase"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CUInt

-- | Finish an asynchronous verify chain operation. See
-- 'GI.Gio.Objects.TlsDatabase.tlsDatabaseVerifyChain' for more information.
-- 
-- If /@chain@/ is found to be valid, then the return value will be 0. If
-- /@chain@/ is found to be invalid, then the return value will indicate
-- the problems found. If the function is unable to determine whether
-- /@chain@/ is valid or not (eg, because /@cancellable@/ is triggered
-- before it completes) then the return value will be
-- 'GI.Gio.Flags.TlsCertificateFlagsGenericError' and /@error@/ will be set
-- accordingly. /@error@/ is not set when /@chain@/ is successfully analyzed
-- but found to be invalid.
-- 
-- /Since: 2.30/
tlsDatabaseVerifyChainFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsTlsDatabase a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@self@/: a t'GI.Gio.Objects.TlsDatabase.TlsDatabase'
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'.
    -> m [Gio.Flags.TlsCertificateFlags]
    -- ^ __Returns:__ the appropriate t'GI.Gio.Flags.TlsCertificateFlags' which represents the
    -- result of verification. /(Can throw 'Data.GI.Base.GError.GError')/
tlsDatabaseVerifyChainFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsTlsDatabase a, IsAsyncResult b) =>
a -> b -> m [TlsCertificateFlags]
tlsDatabaseVerifyChainFinish a
self b
result_ = IO [TlsCertificateFlags] -> m [TlsCertificateFlags]
forall a. IO a -> m a
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
    self' <- a -> IO (Ptr TlsDatabase)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result_' <- unsafeManagedPtrCastPtr result_
    onException (do
        result <- propagateGError $ g_tls_database_verify_chain_finish self' result_'
        let result' = CUInt -> [TlsCertificateFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
        touchManagedPtr self
        touchManagedPtr result_
        return result'
     ) (do
        return ()
     )

#if defined(ENABLE_OVERLOADING)
data TlsDatabaseVerifyChainFinishMethodInfo
instance (signature ~ (b -> m [Gio.Flags.TlsCertificateFlags]), MonadIO m, IsTlsDatabase a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod TlsDatabaseVerifyChainFinishMethodInfo a signature where
    overloadedMethod = tlsDatabaseVerifyChainFinish

instance O.OverloadedMethodInfo TlsDatabaseVerifyChainFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.TlsDatabase.tlsDatabaseVerifyChainFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-TlsDatabase.html#v:tlsDatabaseVerifyChainFinish"
        })


#endif