{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.Gio.Objects.TlsDatabase.TlsDatabase' is used to lookup certificates and other information
-- from a certificate or key store. It is an abstract base class which
-- TLS library specific subtypes override.
-- 
-- A t'GI.Gio.Objects.TlsDatabase.TlsDatabase' 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
-- t'GI.Gio.Objects.TlsDatabase.TlsDatabase'. 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                           ,
    noTlsDatabase                           ,


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

#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.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import qualified GI.GObject.Objects.Object as GObject.Object
import 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

-- | Memory-managed wrapper type.
newtype TlsDatabase = TlsDatabase (ManagedPtr TlsDatabase)
    deriving (TlsDatabase -> TlsDatabase -> Bool
(TlsDatabase -> TlsDatabase -> Bool)
-> (TlsDatabase -> TlsDatabase -> Bool) -> Eq TlsDatabase
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TlsDatabase -> TlsDatabase -> Bool
$c/= :: TlsDatabase -> TlsDatabase -> Bool
== :: TlsDatabase -> TlsDatabase -> Bool
$c== :: TlsDatabase -> TlsDatabase -> Bool
Eq)
foreign import ccall "g_tls_database_get_type"
    c_g_tls_database_get_type :: IO GType

instance GObject TlsDatabase where
    gobjectType :: IO GType
gobjectType = IO GType
c_g_tls_database_get_type
    

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

-- | Type class for types which can be safely cast to `TlsDatabase`, for instance with `toTlsDatabase`.
class (GObject o, O.IsDescendantOf TlsDatabase o) => IsTlsDatabase o
instance (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 :: (MonadIO m, IsTlsDatabase o) => o -> m TlsDatabase
toTlsDatabase :: o -> m TlsDatabase
toTlsDatabase = IO TlsDatabase -> m TlsDatabase
forall (m :: * -> *) a. MonadIO m => IO a -> m a
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, GObject o, GObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr TlsDatabase -> TlsDatabase
TlsDatabase

-- | A convenience alias for `Nothing` :: `Maybe` `TlsDatabase`.
noTlsDatabase :: Maybe TlsDatabase
noTlsDatabase :: Maybe TlsDatabase
noTlsDatabase = Maybe TlsDatabase
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveTlsDatabaseMethod (t :: Symbol) (o :: *) :: * 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.MethodInfo 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

#endif

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

#if defined(ENABLE_OVERLOADING)
#endif

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

#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
--           , 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
--           , 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 :: a -> b -> m (Maybe Text)
tlsDatabaseCreateCertificateHandle self :: a
self certificate :: b
certificate = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr TlsDatabase
self' <- a -> IO (Ptr TlsDatabase)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr TlsCertificate
certificate' <- b -> IO (Ptr TlsCertificate)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
certificate
    CString
result <- Ptr TlsDatabase -> Ptr TlsCertificate -> IO CString
g_tls_database_create_certificate_handle Ptr TlsDatabase
self' Ptr TlsCertificate
certificate'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \result' :: CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
certificate
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data TlsDatabaseCreateCertificateHandleMethodInfo
instance (signature ~ (b -> m (Maybe T.Text)), MonadIO m, IsTlsDatabase a, Gio.TlsCertificate.IsTlsCertificate b) => O.MethodInfo TlsDatabaseCreateCertificateHandleMethodInfo a signature where
    overloadedMethod = 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
--           , 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
--           , 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
--           , 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
--           , 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
--           , 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)

-- | Lookup 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 :: a
-> Text
-> Maybe b
-> TlsDatabaseLookupFlags
-> Maybe c
-> m (Maybe TlsCertificate)
tlsDatabaseLookupCertificateForHandle self :: a
self handle :: Text
handle interaction :: Maybe b
interaction flags :: TlsDatabaseLookupFlags
flags cancellable :: Maybe c
cancellable = IO (Maybe TlsCertificate) -> m (Maybe TlsCertificate)
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
    Ptr TlsDatabase
self' <- a -> IO (Ptr TlsDatabase)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
handle' <- Text -> IO CString
textToCString Text
handle
    Ptr TlsInteraction
maybeInteraction <- case Maybe b
interaction of
        Nothing -> Ptr TlsInteraction -> IO (Ptr TlsInteraction)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TlsInteraction
forall a. Ptr a
nullPtr
        Just jInteraction :: b
jInteraction -> do
            Ptr TlsInteraction
jInteraction' <- b -> IO (Ptr TlsInteraction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jInteraction
            Ptr TlsInteraction -> IO (Ptr TlsInteraction)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TlsInteraction
jInteraction'
    let flags' :: CUInt
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
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO (Maybe TlsCertificate) -> IO () -> IO (Maybe TlsCertificate)
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr TlsCertificate
result <- (Ptr (Ptr GError) -> IO (Ptr TlsCertificate))
-> IO (Ptr TlsCertificate)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr TlsCertificate))
 -> IO (Ptr TlsCertificate))
-> (Ptr (Ptr GError) -> IO (Ptr TlsCertificate))
-> IO (Ptr TlsCertificate)
forall a b. (a -> b) -> a -> b
$ Ptr TlsDatabase
-> CString
-> Ptr TlsInteraction
-> CUInt
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO (Ptr TlsCertificate)
g_tls_database_lookup_certificate_for_handle Ptr TlsDatabase
self' CString
handle' Ptr TlsInteraction
maybeInteraction CUInt
flags' Ptr Cancellable
maybeCancellable
        Maybe TlsCertificate
maybeResult <- Ptr TlsCertificate
-> (Ptr TlsCertificate -> IO TlsCertificate)
-> IO (Maybe TlsCertificate)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr TlsCertificate
result ((Ptr TlsCertificate -> IO TlsCertificate)
 -> IO (Maybe TlsCertificate))
-> (Ptr TlsCertificate -> IO TlsCertificate)
-> IO (Maybe TlsCertificate)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr TlsCertificate
result' -> do
            TlsCertificate
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'
            TlsCertificate -> IO TlsCertificate
forall (m :: * -> *) a. Monad m => a -> m a
return TlsCertificate
result''
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
interaction b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
handle'
        Maybe TlsCertificate -> IO (Maybe TlsCertificate)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TlsCertificate
maybeResult
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
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.MethodInfo TlsDatabaseLookupCertificateForHandleMethodInfo a signature where
    overloadedMethod = 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
--           , 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
--           , 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
--           , 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
--           , 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
--           , 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
--           , 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
--           , 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 lookup 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 :: a
-> Text
-> Maybe b
-> TlsDatabaseLookupFlags
-> Maybe c
-> Maybe AsyncReadyCallback
-> m ()
tlsDatabaseLookupCertificateForHandleAsync self :: a
self handle :: Text
handle interaction :: Maybe b
interaction flags :: TlsDatabaseLookupFlags
flags cancellable :: Maybe c
cancellable callback :: Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr TlsDatabase
self' <- a -> IO (Ptr TlsDatabase)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
handle' <- Text -> IO CString
textToCString Text
handle
    Ptr TlsInteraction
maybeInteraction <- case Maybe b
interaction of
        Nothing -> Ptr TlsInteraction -> IO (Ptr TlsInteraction)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TlsInteraction
forall a. Ptr a
nullPtr
        Just jInteraction :: b
jInteraction -> do
            Ptr TlsInteraction
jInteraction' <- b -> IO (Ptr TlsInteraction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jInteraction
            Ptr TlsInteraction -> IO (Ptr TlsInteraction)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TlsInteraction
jInteraction'
    let flags' :: CUInt
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
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just jCallback :: AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr TlsDatabase
-> CString
-> Ptr TlsInteraction
-> CUInt
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_tls_database_lookup_certificate_for_handle_async Ptr TlsDatabase
self' CString
handle' Ptr TlsInteraction
maybeInteraction CUInt
flags' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
interaction b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
handle'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
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.MethodInfo TlsDatabaseLookupCertificateForHandleAsyncMethodInfo a signature where
    overloadedMethod = 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
--           , 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
--           , 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
-- @/g_tls_database_lookup_certificate_by_handle()/@ 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 :: a -> b -> m TlsCertificate
tlsDatabaseLookupCertificateForHandleFinish self :: a
self result_ :: b
result_ = IO TlsCertificate -> m TlsCertificate
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
    Ptr TlsDatabase
self' <- a -> IO (Ptr TlsDatabase)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO TlsCertificate -> IO () -> IO TlsCertificate
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr TlsCertificate
result <- (Ptr (Ptr GError) -> IO (Ptr TlsCertificate))
-> IO (Ptr TlsCertificate)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr TlsCertificate))
 -> IO (Ptr TlsCertificate))
-> (Ptr (Ptr GError) -> IO (Ptr TlsCertificate))
-> IO (Ptr TlsCertificate)
forall a b. (a -> b) -> a -> b
$ Ptr TlsDatabase
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr TlsCertificate)
g_tls_database_lookup_certificate_for_handle_finish Ptr TlsDatabase
self' Ptr AsyncResult
result_'
        Text -> Ptr TlsCertificate -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "tlsDatabaseLookupCertificateForHandleFinish" Ptr TlsCertificate
result
        TlsCertificate
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
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        TlsCertificate -> IO TlsCertificate
forall (m :: * -> *) a. Monad m => a -> m a
return TlsCertificate
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data TlsDatabaseLookupCertificateForHandleFinishMethodInfo
instance (signature ~ (b -> m Gio.TlsCertificate.TlsCertificate), MonadIO m, IsTlsDatabase a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo TlsDatabaseLookupCertificateForHandleFinishMethodInfo a signature where
    overloadedMethod = 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
--           , 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
--           , 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
--           , 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
--           , 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
--           , 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)

-- | Lookup the issuer of /@certificate@/ in the database.
-- 
-- The t'GI.Gio.Objects.TlsCertificate.TlsCertificate':@/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.
-- 
-- /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 :: a
-> b
-> Maybe c
-> TlsDatabaseLookupFlags
-> Maybe d
-> m TlsCertificate
tlsDatabaseLookupCertificateIssuer self :: a
self certificate :: b
certificate interaction :: Maybe c
interaction flags :: TlsDatabaseLookupFlags
flags cancellable :: Maybe d
cancellable = IO TlsCertificate -> m TlsCertificate
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
    Ptr TlsDatabase
self' <- a -> IO (Ptr TlsDatabase)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr TlsCertificate
certificate' <- b -> IO (Ptr TlsCertificate)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
certificate
    Ptr TlsInteraction
maybeInteraction <- case Maybe c
interaction of
        Nothing -> Ptr TlsInteraction -> IO (Ptr TlsInteraction)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TlsInteraction
forall a. Ptr a
nullPtr
        Just jInteraction :: c
jInteraction -> do
            Ptr TlsInteraction
jInteraction' <- c -> IO (Ptr TlsInteraction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jInteraction
            Ptr TlsInteraction -> IO (Ptr TlsInteraction)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TlsInteraction
jInteraction'
    let flags' :: CUInt
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
    Ptr Cancellable
maybeCancellable <- case Maybe d
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: d
jCancellable -> do
            Ptr Cancellable
jCancellable' <- d -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr d
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO TlsCertificate -> IO () -> IO TlsCertificate
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr TlsCertificate
result <- (Ptr (Ptr GError) -> IO (Ptr TlsCertificate))
-> IO (Ptr TlsCertificate)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr TlsCertificate))
 -> IO (Ptr TlsCertificate))
-> (Ptr (Ptr GError) -> IO (Ptr TlsCertificate))
-> IO (Ptr TlsCertificate)
forall a b. (a -> b) -> a -> b
$ Ptr TlsDatabase
-> Ptr TlsCertificate
-> Ptr TlsInteraction
-> CUInt
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO (Ptr TlsCertificate)
g_tls_database_lookup_certificate_issuer Ptr TlsDatabase
self' Ptr TlsCertificate
certificate' Ptr TlsInteraction
maybeInteraction CUInt
flags' Ptr Cancellable
maybeCancellable
        Text -> Ptr TlsCertificate -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "tlsDatabaseLookupCertificateIssuer" Ptr TlsCertificate
result
        TlsCertificate
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
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
certificate
        Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
interaction c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Maybe d -> (d -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe d
cancellable d -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        TlsCertificate -> IO TlsCertificate
forall (m :: * -> *) a. Monad m => a -> m a
return TlsCertificate
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
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.MethodInfo TlsDatabaseLookupCertificateIssuerMethodInfo a signature where
    overloadedMethod = 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
--           , 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
--           , 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
--           , 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
--           , 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
--           , 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
--           , 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
--           , 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 lookup 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 :: a
-> b
-> Maybe c
-> TlsDatabaseLookupFlags
-> Maybe d
-> Maybe AsyncReadyCallback
-> m ()
tlsDatabaseLookupCertificateIssuerAsync self :: a
self certificate :: b
certificate interaction :: Maybe c
interaction flags :: TlsDatabaseLookupFlags
flags cancellable :: Maybe d
cancellable callback :: Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr TlsDatabase
self' <- a -> IO (Ptr TlsDatabase)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr TlsCertificate
certificate' <- b -> IO (Ptr TlsCertificate)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
certificate
    Ptr TlsInteraction
maybeInteraction <- case Maybe c
interaction of
        Nothing -> Ptr TlsInteraction -> IO (Ptr TlsInteraction)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TlsInteraction
forall a. Ptr a
nullPtr
        Just jInteraction :: c
jInteraction -> do
            Ptr TlsInteraction
jInteraction' <- c -> IO (Ptr TlsInteraction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jInteraction
            Ptr TlsInteraction -> IO (Ptr TlsInteraction)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TlsInteraction
jInteraction'
    let flags' :: CUInt
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
    Ptr Cancellable
maybeCancellable <- case Maybe d
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: d
jCancellable -> do
            Ptr Cancellable
jCancellable' <- d -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr d
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just jCallback :: AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr TlsDatabase
-> Ptr TlsCertificate
-> Ptr TlsInteraction
-> CUInt
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_tls_database_lookup_certificate_issuer_async Ptr TlsDatabase
self' Ptr TlsCertificate
certificate' Ptr TlsInteraction
maybeInteraction CUInt
flags' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
certificate
    Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
interaction c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe d -> (d -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe d
cancellable d -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
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.MethodInfo TlsDatabaseLookupCertificateIssuerAsyncMethodInfo a signature where
    overloadedMethod = 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
--           , 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
--           , 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 :: a -> b -> m TlsCertificate
tlsDatabaseLookupCertificateIssuerFinish self :: a
self result_ :: b
result_ = IO TlsCertificate -> m TlsCertificate
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
    Ptr TlsDatabase
self' <- a -> IO (Ptr TlsDatabase)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO TlsCertificate -> IO () -> IO TlsCertificate
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr TlsCertificate
result <- (Ptr (Ptr GError) -> IO (Ptr TlsCertificate))
-> IO (Ptr TlsCertificate)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr TlsCertificate))
 -> IO (Ptr TlsCertificate))
-> (Ptr (Ptr GError) -> IO (Ptr TlsCertificate))
-> IO (Ptr TlsCertificate)
forall a b. (a -> b) -> a -> b
$ Ptr TlsDatabase
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr TlsCertificate)
g_tls_database_lookup_certificate_issuer_finish Ptr TlsDatabase
self' Ptr AsyncResult
result_'
        Text -> Ptr TlsCertificate -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "tlsDatabaseLookupCertificateIssuerFinish" Ptr TlsCertificate
result
        TlsCertificate
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
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        TlsCertificate -> IO TlsCertificate
forall (m :: * -> *) a. Monad m => a -> m a
return TlsCertificate
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data TlsDatabaseLookupCertificateIssuerFinishMethodInfo
instance (signature ~ (b -> m Gio.TlsCertificate.TlsCertificate), MonadIO m, IsTlsDatabase a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo TlsDatabaseLookupCertificateIssuerFinishMethodInfo a signature where
    overloadedMethod = 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
--           , 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
--           , 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
--           , 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
--           , 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
--           , 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)))

-- | Lookup 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 :: a
-> ByteString
-> Maybe b
-> TlsDatabaseLookupFlags
-> Maybe c
-> m [TlsCertificate]
tlsDatabaseLookupCertificatesIssuedBy self :: a
self issuerRawDn :: ByteString
issuerRawDn interaction :: Maybe b
interaction flags :: TlsDatabaseLookupFlags
flags cancellable :: Maybe c
cancellable = IO [TlsCertificate] -> m [TlsCertificate]
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
    Ptr TlsDatabase
self' <- a -> IO (Ptr TlsDatabase)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr GByteArray
issuerRawDn' <- ByteString -> IO (Ptr GByteArray)
packGByteArray ByteString
issuerRawDn
    Ptr TlsInteraction
maybeInteraction <- case Maybe b
interaction of
        Nothing -> Ptr TlsInteraction -> IO (Ptr TlsInteraction)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TlsInteraction
forall a. Ptr a
nullPtr
        Just jInteraction :: b
jInteraction -> do
            Ptr TlsInteraction
jInteraction' <- b -> IO (Ptr TlsInteraction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jInteraction
            Ptr TlsInteraction -> IO (Ptr TlsInteraction)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TlsInteraction
jInteraction'
    let flags' :: CUInt
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
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO [TlsCertificate] -> IO () -> IO [TlsCertificate]
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr (GList (Ptr TlsCertificate))
result <- (Ptr (Ptr GError) -> IO (Ptr (GList (Ptr TlsCertificate))))
-> IO (Ptr (GList (Ptr TlsCertificate)))
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr (GList (Ptr TlsCertificate))))
 -> IO (Ptr (GList (Ptr TlsCertificate))))
-> (Ptr (Ptr GError) -> IO (Ptr (GList (Ptr TlsCertificate))))
-> IO (Ptr (GList (Ptr TlsCertificate)))
forall a b. (a -> b) -> a -> b
$ Ptr TlsDatabase
-> Ptr GByteArray
-> Ptr TlsInteraction
-> CUInt
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO (Ptr (GList (Ptr TlsCertificate)))
g_tls_database_lookup_certificates_issued_by Ptr TlsDatabase
self' Ptr GByteArray
issuerRawDn' Ptr TlsInteraction
maybeInteraction CUInt
flags' Ptr Cancellable
maybeCancellable
        [Ptr TlsCertificate]
result' <- Ptr (GList (Ptr TlsCertificate)) -> IO [Ptr TlsCertificate]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr TlsCertificate))
result
        [TlsCertificate]
result'' <- (Ptr TlsCertificate -> IO TlsCertificate)
-> [Ptr TlsCertificate] -> IO [TlsCertificate]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((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'
        Ptr (GList (Ptr TlsCertificate)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr TlsCertificate))
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
interaction b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Ptr GByteArray -> IO ()
unrefGByteArray Ptr GByteArray
issuerRawDn'
        [TlsCertificate] -> IO [TlsCertificate]
forall (m :: * -> *) a. Monad m => a -> m a
return [TlsCertificate]
result''
     ) (do
        Ptr GByteArray -> IO ()
unrefGByteArray Ptr GByteArray
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.MethodInfo TlsDatabaseLookupCertificatesIssuedByMethodInfo a signature where
    overloadedMethod = 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
--           , 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
--           , 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
--           , 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
--           , 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
--           , 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
--           , 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
--           , 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 lookup 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 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 :: a
-> ByteString
-> Maybe b
-> TlsDatabaseLookupFlags
-> Maybe c
-> Maybe AsyncReadyCallback
-> m ()
tlsDatabaseLookupCertificatesIssuedByAsync self :: a
self issuerRawDn :: ByteString
issuerRawDn interaction :: Maybe b
interaction flags :: TlsDatabaseLookupFlags
flags cancellable :: Maybe c
cancellable callback :: Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr TlsDatabase
self' <- a -> IO (Ptr TlsDatabase)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr GByteArray
issuerRawDn' <- ByteString -> IO (Ptr GByteArray)
packGByteArray ByteString
issuerRawDn
    Ptr TlsInteraction
maybeInteraction <- case Maybe b
interaction of
        Nothing -> Ptr TlsInteraction -> IO (Ptr TlsInteraction)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TlsInteraction
forall a. Ptr a
nullPtr
        Just jInteraction :: b
jInteraction -> do
            Ptr TlsInteraction
jInteraction' <- b -> IO (Ptr TlsInteraction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jInteraction
            Ptr TlsInteraction -> IO (Ptr TlsInteraction)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TlsInteraction
jInteraction'
    let flags' :: CUInt
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
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just jCallback :: AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr TlsDatabase
-> Ptr GByteArray
-> Ptr TlsInteraction
-> CUInt
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_tls_database_lookup_certificates_issued_by_async Ptr TlsDatabase
self' Ptr GByteArray
issuerRawDn' Ptr TlsInteraction
maybeInteraction CUInt
flags' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
interaction b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Ptr GByteArray -> IO ()
unrefGByteArray Ptr GByteArray
issuerRawDn'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
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.MethodInfo TlsDatabaseLookupCertificatesIssuedByAsyncMethodInfo a signature where
    overloadedMethod = 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
--           , 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
--           , 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 :: a -> b -> m [TlsCertificate]
tlsDatabaseLookupCertificatesIssuedByFinish self :: a
self result_ :: b
result_ = IO [TlsCertificate] -> m [TlsCertificate]
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
    Ptr TlsDatabase
self' <- a -> IO (Ptr TlsDatabase)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO [TlsCertificate] -> IO () -> IO [TlsCertificate]
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr (GList (Ptr TlsCertificate))
result <- (Ptr (Ptr GError) -> IO (Ptr (GList (Ptr TlsCertificate))))
-> IO (Ptr (GList (Ptr TlsCertificate)))
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr (GList (Ptr TlsCertificate))))
 -> IO (Ptr (GList (Ptr TlsCertificate))))
-> (Ptr (Ptr GError) -> IO (Ptr (GList (Ptr TlsCertificate))))
-> IO (Ptr (GList (Ptr TlsCertificate)))
forall a b. (a -> b) -> a -> b
$ Ptr TlsDatabase
-> Ptr AsyncResult
-> Ptr (Ptr GError)
-> IO (Ptr (GList (Ptr TlsCertificate)))
g_tls_database_lookup_certificates_issued_by_finish Ptr TlsDatabase
self' Ptr AsyncResult
result_'
        [Ptr TlsCertificate]
result' <- Ptr (GList (Ptr TlsCertificate)) -> IO [Ptr TlsCertificate]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr TlsCertificate))
result
        [TlsCertificate]
result'' <- (Ptr TlsCertificate -> IO TlsCertificate)
-> [Ptr TlsCertificate] -> IO [TlsCertificate]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((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'
        Ptr (GList (Ptr TlsCertificate)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr TlsCertificate))
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        [TlsCertificate] -> IO [TlsCertificate]
forall (m :: * -> *) a. Monad m => a -> m a
return [TlsCertificate]
result''
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data TlsDatabaseLookupCertificatesIssuedByFinishMethodInfo
instance (signature ~ (b -> m [Gio.TlsCertificate.TlsCertificate]), MonadIO m, IsTlsDatabase a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo TlsDatabaseLookupCertificatesIssuedByFinishMethodInfo a signature where
    overloadedMethod = 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
--           , 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
--           , 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
--           , 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
--           , 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
--           , 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
--           , 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
--           , 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 after looking up and
-- adding any missing certificates to the chain.
-- 
-- /@chain@/ is a chain of t'GI.Gio.Objects.TlsCertificate.TlsCertificate' objects each pointing to the next
-- certificate in the chain by its t'GI.Gio.Objects.TlsCertificate.TlsCertificate':@/issuer/@ property. The chain may initially
-- consist of one or more certificates. After the verification process is
-- complete, /@chain@/ may be modified by adding missing certificates, or removing
-- extra certificates. If a certificate anchor was found, then it is added to
-- the /@chain@/.
-- 
-- /@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 check for pinned certificates (trust exceptions)
-- in the database. These will 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
-- 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.
-- 
-- 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 :: a
-> b
-> Text
-> Maybe c
-> Maybe d
-> [TlsDatabaseVerifyFlags]
-> Maybe e
-> m [TlsCertificateFlags]
tlsDatabaseVerifyChain self :: a
self chain :: b
chain purpose :: Text
purpose identity :: Maybe c
identity interaction :: Maybe d
interaction flags :: [TlsDatabaseVerifyFlags]
flags cancellable :: Maybe e
cancellable = IO [TlsCertificateFlags] -> m [TlsCertificateFlags]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [TlsCertificateFlags] -> m [TlsCertificateFlags])
-> IO [TlsCertificateFlags] -> m [TlsCertificateFlags]
forall a b. (a -> b) -> a -> b
$ do
    Ptr TlsDatabase
self' <- a -> IO (Ptr TlsDatabase)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr TlsCertificate
chain' <- b -> IO (Ptr TlsCertificate)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
chain
    CString
purpose' <- Text -> IO CString
textToCString Text
purpose
    Ptr SocketConnectable
maybeIdentity <- case Maybe c
identity of
        Nothing -> Ptr SocketConnectable -> IO (Ptr SocketConnectable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr SocketConnectable
forall a. Ptr a
nullPtr
        Just jIdentity :: c
jIdentity -> do
            Ptr SocketConnectable
jIdentity' <- c -> IO (Ptr SocketConnectable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jIdentity
            Ptr SocketConnectable -> IO (Ptr SocketConnectable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr SocketConnectable
jIdentity'
    Ptr TlsInteraction
maybeInteraction <- case Maybe d
interaction of
        Nothing -> Ptr TlsInteraction -> IO (Ptr TlsInteraction)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TlsInteraction
forall a. Ptr a
nullPtr
        Just jInteraction :: d
jInteraction -> do
            Ptr TlsInteraction
jInteraction' <- d -> IO (Ptr TlsInteraction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr d
jInteraction
            Ptr TlsInteraction -> IO (Ptr TlsInteraction)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TlsInteraction
jInteraction'
    let flags' :: CUInt
flags' = [TlsDatabaseVerifyFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [TlsDatabaseVerifyFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe e
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: e
jCancellable -> do
            Ptr Cancellable
jCancellable' <- e -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr e
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO [TlsCertificateFlags] -> IO () -> IO [TlsCertificateFlags]
forall a b. IO a -> IO b -> IO a
onException (do
        CUInt
result <- (Ptr (Ptr GError) -> IO CUInt) -> IO CUInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CUInt) -> IO CUInt)
-> (Ptr (Ptr GError) -> IO CUInt) -> IO CUInt
forall a b. (a -> b) -> a -> b
$ Ptr TlsDatabase
-> Ptr TlsCertificate
-> CString
-> Ptr SocketConnectable
-> Ptr TlsInteraction
-> CUInt
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CUInt
g_tls_database_verify_chain Ptr TlsDatabase
self' Ptr TlsCertificate
chain' CString
purpose' Ptr SocketConnectable
maybeIdentity Ptr TlsInteraction
maybeInteraction CUInt
flags' Ptr Cancellable
maybeCancellable
        let result' :: [TlsCertificateFlags]
result' = CUInt -> [TlsCertificateFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
chain
        Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
identity c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Maybe d -> (d -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe d
interaction d -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Maybe e -> (e -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe e
cancellable e -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
purpose'
        [TlsCertificateFlags] -> IO [TlsCertificateFlags]
forall (m :: * -> *) a. Monad m => a -> m a
return [TlsCertificateFlags]
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
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.MethodInfo TlsDatabaseVerifyChainMethodInfo a signature where
    overloadedMethod = 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
--           , 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
--           , 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
--           , 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
--           , 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
--           , 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
--           , 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
--           , 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
--           , 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
--           , 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 :: a
-> b
-> Text
-> Maybe c
-> Maybe d
-> [TlsDatabaseVerifyFlags]
-> Maybe e
-> Maybe AsyncReadyCallback
-> m ()
tlsDatabaseVerifyChainAsync self :: a
self chain :: b
chain purpose :: Text
purpose identity :: Maybe c
identity interaction :: Maybe d
interaction flags :: [TlsDatabaseVerifyFlags]
flags cancellable :: Maybe e
cancellable callback :: Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr TlsDatabase
self' <- a -> IO (Ptr TlsDatabase)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr TlsCertificate
chain' <- b -> IO (Ptr TlsCertificate)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
chain
    CString
purpose' <- Text -> IO CString
textToCString Text
purpose
    Ptr SocketConnectable
maybeIdentity <- case Maybe c
identity of
        Nothing -> Ptr SocketConnectable -> IO (Ptr SocketConnectable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr SocketConnectable
forall a. Ptr a
nullPtr
        Just jIdentity :: c
jIdentity -> do
            Ptr SocketConnectable
jIdentity' <- c -> IO (Ptr SocketConnectable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jIdentity
            Ptr SocketConnectable -> IO (Ptr SocketConnectable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr SocketConnectable
jIdentity'
    Ptr TlsInteraction
maybeInteraction <- case Maybe d
interaction of
        Nothing -> Ptr TlsInteraction -> IO (Ptr TlsInteraction)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TlsInteraction
forall a. Ptr a
nullPtr
        Just jInteraction :: d
jInteraction -> do
            Ptr TlsInteraction
jInteraction' <- d -> IO (Ptr TlsInteraction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr d
jInteraction
            Ptr TlsInteraction -> IO (Ptr TlsInteraction)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TlsInteraction
jInteraction'
    let flags' :: CUInt
flags' = [TlsDatabaseVerifyFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [TlsDatabaseVerifyFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe e
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: e
jCancellable -> do
            Ptr Cancellable
jCancellable' <- e -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr e
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just jCallback :: AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr TlsDatabase
-> Ptr TlsCertificate
-> CString
-> Ptr SocketConnectable
-> Ptr TlsInteraction
-> CUInt
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_tls_database_verify_chain_async Ptr TlsDatabase
self' Ptr TlsCertificate
chain' CString
purpose' Ptr SocketConnectable
maybeIdentity Ptr TlsInteraction
maybeInteraction CUInt
flags' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
chain
    Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
identity c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe d -> (d -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe d
interaction d -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe e -> (e -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe e
cancellable e -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
purpose'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
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.MethodInfo TlsDatabaseVerifyChainAsyncMethodInfo a signature where
    overloadedMethod = 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
--           , 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
--           , 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 :: a -> b -> m [TlsCertificateFlags]
tlsDatabaseVerifyChainFinish self :: a
self result_ :: b
result_ = IO [TlsCertificateFlags] -> m [TlsCertificateFlags]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [TlsCertificateFlags] -> m [TlsCertificateFlags])
-> IO [TlsCertificateFlags] -> m [TlsCertificateFlags]
forall a b. (a -> b) -> a -> b
$ do
    Ptr TlsDatabase
self' <- a -> IO (Ptr TlsDatabase)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO [TlsCertificateFlags] -> IO () -> IO [TlsCertificateFlags]
forall a b. IO a -> IO b -> IO a
onException (do
        CUInt
result <- (Ptr (Ptr GError) -> IO CUInt) -> IO CUInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CUInt) -> IO CUInt)
-> (Ptr (Ptr GError) -> IO CUInt) -> IO CUInt
forall a b. (a -> b) -> a -> b
$ Ptr TlsDatabase -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CUInt
g_tls_database_verify_chain_finish Ptr TlsDatabase
self' Ptr AsyncResult
result_'
        let result' :: [TlsCertificateFlags]
result' = CUInt -> [TlsCertificateFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        [TlsCertificateFlags] -> IO [TlsCertificateFlags]
forall (m :: * -> *) a. Monad m => a -> m a
return [TlsCertificateFlags]
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

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

#endif