{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A certificate used for TLS authentication and encryption.
-- This can represent either a certificate only (eg, the certificate
-- received by a client from a server), or the combination of
-- a certificate and a private key (which is needed when acting as a
-- t'GI.Gio.Interfaces.TlsServerConnection.TlsServerConnection').
-- 
-- /Since: 2.28/

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

module GI.Gio.Objects.TlsCertificate
    ( 

-- * Exported types
    TlsCertificate(..)                      ,
    IsTlsCertificate                        ,
    toTlsCertificate                        ,
    noTlsCertificate                        ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveTlsCertificateMethod             ,
#endif


-- ** getIssuer #method:getIssuer#

#if defined(ENABLE_OVERLOADING)
    TlsCertificateGetIssuerMethodInfo       ,
#endif
    tlsCertificateGetIssuer                 ,


-- ** isSame #method:isSame#

#if defined(ENABLE_OVERLOADING)
    TlsCertificateIsSameMethodInfo          ,
#endif
    tlsCertificateIsSame                    ,


-- ** listNewFromFile #method:listNewFromFile#

    tlsCertificateListNewFromFile           ,


-- ** newFromFile #method:newFromFile#

    tlsCertificateNewFromFile               ,


-- ** newFromFiles #method:newFromFiles#

    tlsCertificateNewFromFiles              ,


-- ** newFromPem #method:newFromPem#

    tlsCertificateNewFromPem                ,


-- ** verify #method:verify#

#if defined(ENABLE_OVERLOADING)
    TlsCertificateVerifyMethodInfo          ,
#endif
    tlsCertificateVerify                    ,




 -- * Properties
-- ** certificate #attr:certificate#
-- | The DER (binary) encoded representation of the certificate.
-- This property and the t'GI.Gio.Objects.TlsCertificate.TlsCertificate':@/certificate-pem/@ property
-- represent the same data, just in different forms.
-- 
-- /Since: 2.28/

#if defined(ENABLE_OVERLOADING)
    TlsCertificateCertificatePropertyInfo   ,
#endif
    constructTlsCertificateCertificate      ,
    getTlsCertificateCertificate            ,
#if defined(ENABLE_OVERLOADING)
    tlsCertificateCertificate               ,
#endif


-- ** certificatePem #attr:certificatePem#
-- | The PEM (ASCII) encoded representation of the certificate.
-- This property and the t'GI.Gio.Objects.TlsCertificate.TlsCertificate':@/certificate/@
-- property represent the same data, just in different forms.
-- 
-- /Since: 2.28/

#if defined(ENABLE_OVERLOADING)
    TlsCertificateCertificatePemPropertyInfo,
#endif
    constructTlsCertificateCertificatePem   ,
    getTlsCertificateCertificatePem         ,
#if defined(ENABLE_OVERLOADING)
    tlsCertificateCertificatePem            ,
#endif


-- ** issuer #attr:issuer#
-- | A t'GI.Gio.Objects.TlsCertificate.TlsCertificate' representing the entity that issued this
-- certificate. If 'P.Nothing', this means that the certificate is either
-- self-signed, or else the certificate of the issuer is not
-- available.
-- 
-- /Since: 2.28/

#if defined(ENABLE_OVERLOADING)
    TlsCertificateIssuerPropertyInfo        ,
#endif
    constructTlsCertificateIssuer           ,
    getTlsCertificateIssuer                 ,
#if defined(ENABLE_OVERLOADING)
    tlsCertificateIssuer                    ,
#endif


-- ** privateKey #attr:privateKey#
-- | The DER (binary) encoded representation of the certificate\'s
-- private key, in either PKCS@/1/@ format or unencrypted PKCS@/8/@
-- format. This property (or the t'GI.Gio.Objects.TlsCertificate.TlsCertificate':@/private-key-pem/@
-- property) can be set when constructing a key (eg, from a file),
-- but cannot be read.
-- 
-- PKCS@/8/@ format is supported since 2.32; earlier releases only
-- support PKCS@/1/@. You can use the @openssl rsa@
-- tool to convert PKCS@/8/@ keys to PKCS@/1/@.
-- 
-- /Since: 2.28/

#if defined(ENABLE_OVERLOADING)
    TlsCertificatePrivateKeyPropertyInfo    ,
#endif
    constructTlsCertificatePrivateKey       ,
#if defined(ENABLE_OVERLOADING)
    tlsCertificatePrivateKey                ,
#endif


-- ** privateKeyPem #attr:privateKeyPem#
-- | The PEM (ASCII) encoded representation of the certificate\'s
-- private key in either PKCS@/1/@ format (\"@BEGIN RSA PRIVATE
-- KEY@\") or unencrypted PKCS@/8/@ format (\"@BEGIN
-- PRIVATE KEY@\"). This property (or the
-- t'GI.Gio.Objects.TlsCertificate.TlsCertificate':@/private-key/@ property) can be set when
-- constructing a key (eg, from a file), but cannot be read.
-- 
-- PKCS@/8/@ format is supported since 2.32; earlier releases only
-- support PKCS@/1/@. You can use the @openssl rsa@
-- tool to convert PKCS@/8/@ keys to PKCS@/1/@.
-- 
-- /Since: 2.28/

#if defined(ENABLE_OVERLOADING)
    TlsCertificatePrivateKeyPemPropertyInfo ,
#endif
    constructTlsCertificatePrivateKeyPem    ,
#if defined(ENABLE_OVERLOADING)
    tlsCertificatePrivateKeyPem             ,
#endif




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gio.Flags as Gio.Flags
import {-# SOURCE #-} qualified GI.Gio.Interfaces.SocketConnectable as Gio.SocketConnectable

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

instance GObject TlsCertificate where
    gobjectType :: IO GType
gobjectType = IO GType
c_g_tls_certificate_get_type
    

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

-- | Type class for types which can be safely cast to `TlsCertificate`, for instance with `toTlsCertificate`.
class (GObject o, O.IsDescendantOf TlsCertificate o) => IsTlsCertificate o
instance (GObject o, O.IsDescendantOf TlsCertificate o) => IsTlsCertificate o

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

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

-- | A convenience alias for `Nothing` :: `Maybe` `TlsCertificate`.
noTlsCertificate :: Maybe TlsCertificate
noTlsCertificate :: Maybe TlsCertificate
noTlsCertificate = Maybe TlsCertificate
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveTlsCertificateMethod (t :: Symbol) (o :: *) :: * where
    ResolveTlsCertificateMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveTlsCertificateMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveTlsCertificateMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveTlsCertificateMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveTlsCertificateMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveTlsCertificateMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveTlsCertificateMethod "isSame" o = TlsCertificateIsSameMethodInfo
    ResolveTlsCertificateMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveTlsCertificateMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveTlsCertificateMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveTlsCertificateMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveTlsCertificateMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveTlsCertificateMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveTlsCertificateMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveTlsCertificateMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveTlsCertificateMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveTlsCertificateMethod "verify" o = TlsCertificateVerifyMethodInfo
    ResolveTlsCertificateMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveTlsCertificateMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveTlsCertificateMethod "getIssuer" o = TlsCertificateGetIssuerMethodInfo
    ResolveTlsCertificateMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveTlsCertificateMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveTlsCertificateMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveTlsCertificateMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveTlsCertificateMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveTlsCertificateMethod l o = O.MethodResolutionFailed l o

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

#endif

-- VVV Prop "certificate"
   -- Type: TByteArray
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@certificate@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' tlsCertificate #certificate
-- @
getTlsCertificateCertificate :: (MonadIO m, IsTlsCertificate o) => o -> m (Maybe ByteString)
getTlsCertificateCertificate :: o -> m (Maybe ByteString)
getTlsCertificateCertificate obj :: o
obj = IO (Maybe ByteString) -> m (Maybe ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ByteString) -> m (Maybe ByteString))
-> IO (Maybe ByteString) -> m (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe ByteString)
forall a. GObject a => a -> String -> IO (Maybe ByteString)
B.Properties.getObjectPropertyByteArray o
obj "certificate"

-- | Construct a `GValueConstruct` with valid value for the “@certificate@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTlsCertificateCertificate :: (IsTlsCertificate o, MIO.MonadIO m) => ByteString -> m (GValueConstruct o)
constructTlsCertificateCertificate :: ByteString -> m (GValueConstruct o)
constructTlsCertificateCertificate val :: ByteString
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe ByteString -> IO (GValueConstruct o)
forall o. String -> Maybe ByteString -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyByteArray "certificate" (ByteString -> Maybe ByteString
forall a. a -> Maybe a
P.Just ByteString
val)

#if defined(ENABLE_OVERLOADING)
data TlsCertificateCertificatePropertyInfo
instance AttrInfo TlsCertificateCertificatePropertyInfo where
    type AttrAllowedOps TlsCertificateCertificatePropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint TlsCertificateCertificatePropertyInfo = IsTlsCertificate
    type AttrSetTypeConstraint TlsCertificateCertificatePropertyInfo = (~) ByteString
    type AttrTransferTypeConstraint TlsCertificateCertificatePropertyInfo = (~) ByteString
    type AttrTransferType TlsCertificateCertificatePropertyInfo = ByteString
    type AttrGetType TlsCertificateCertificatePropertyInfo = (Maybe ByteString)
    type AttrLabel TlsCertificateCertificatePropertyInfo = "certificate"
    type AttrOrigin TlsCertificateCertificatePropertyInfo = TlsCertificate
    attrGet = getTlsCertificateCertificate
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructTlsCertificateCertificate
    attrClear = undefined
#endif

-- VVV Prop "certificate-pem"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@certificate-pem@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' tlsCertificate #certificatePem
-- @
getTlsCertificateCertificatePem :: (MonadIO m, IsTlsCertificate o) => o -> m (Maybe T.Text)
getTlsCertificateCertificatePem :: o -> m (Maybe Text)
getTlsCertificateCertificatePem obj :: o
obj = 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
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj "certificate-pem"

-- | Construct a `GValueConstruct` with valid value for the “@certificate-pem@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTlsCertificateCertificatePem :: (IsTlsCertificate o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructTlsCertificateCertificatePem :: Text -> m (GValueConstruct o)
constructTlsCertificateCertificatePem val :: Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString "certificate-pem" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data TlsCertificateCertificatePemPropertyInfo
instance AttrInfo TlsCertificateCertificatePemPropertyInfo where
    type AttrAllowedOps TlsCertificateCertificatePemPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint TlsCertificateCertificatePemPropertyInfo = IsTlsCertificate
    type AttrSetTypeConstraint TlsCertificateCertificatePemPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint TlsCertificateCertificatePemPropertyInfo = (~) T.Text
    type AttrTransferType TlsCertificateCertificatePemPropertyInfo = T.Text
    type AttrGetType TlsCertificateCertificatePemPropertyInfo = (Maybe T.Text)
    type AttrLabel TlsCertificateCertificatePemPropertyInfo = "certificate-pem"
    type AttrOrigin TlsCertificateCertificatePemPropertyInfo = TlsCertificate
    attrGet = getTlsCertificateCertificatePem
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructTlsCertificateCertificatePem
    attrClear = undefined
#endif

-- VVV Prop "issuer"
   -- Type: TInterface (Name {namespace = "Gio", name = "TlsCertificate"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@issuer@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' tlsCertificate #issuer
-- @
getTlsCertificateIssuer :: (MonadIO m, IsTlsCertificate o) => o -> m TlsCertificate
getTlsCertificateIssuer :: o -> m TlsCertificate
getTlsCertificateIssuer obj :: o
obj = 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
$ Text -> IO (Maybe TlsCertificate) -> IO TlsCertificate
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing "getTlsCertificateIssuer" (IO (Maybe TlsCertificate) -> IO TlsCertificate)
-> IO (Maybe TlsCertificate) -> IO TlsCertificate
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr TlsCertificate -> TlsCertificate)
-> IO (Maybe TlsCertificate)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj "issuer" ManagedPtr TlsCertificate -> TlsCertificate
TlsCertificate

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

#if defined(ENABLE_OVERLOADING)
data TlsCertificateIssuerPropertyInfo
instance AttrInfo TlsCertificateIssuerPropertyInfo where
    type AttrAllowedOps TlsCertificateIssuerPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint TlsCertificateIssuerPropertyInfo = IsTlsCertificate
    type AttrSetTypeConstraint TlsCertificateIssuerPropertyInfo = IsTlsCertificate
    type AttrTransferTypeConstraint TlsCertificateIssuerPropertyInfo = IsTlsCertificate
    type AttrTransferType TlsCertificateIssuerPropertyInfo = TlsCertificate
    type AttrGetType TlsCertificateIssuerPropertyInfo = TlsCertificate
    type AttrLabel TlsCertificateIssuerPropertyInfo = "issuer"
    type AttrOrigin TlsCertificateIssuerPropertyInfo = TlsCertificate
    attrGet = getTlsCertificateIssuer
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo TlsCertificate v
    attrConstruct = constructTlsCertificateIssuer
    attrClear = undefined
#endif

-- VVV Prop "private-key"
   -- Type: TByteArray
   -- Flags: [PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Construct a `GValueConstruct` with valid value for the “@private-key@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTlsCertificatePrivateKey :: (IsTlsCertificate o, MIO.MonadIO m) => ByteString -> m (GValueConstruct o)
constructTlsCertificatePrivateKey :: ByteString -> m (GValueConstruct o)
constructTlsCertificatePrivateKey val :: ByteString
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe ByteString -> IO (GValueConstruct o)
forall o. String -> Maybe ByteString -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyByteArray "private-key" (ByteString -> Maybe ByteString
forall a. a -> Maybe a
P.Just ByteString
val)

#if defined(ENABLE_OVERLOADING)
data TlsCertificatePrivateKeyPropertyInfo
instance AttrInfo TlsCertificatePrivateKeyPropertyInfo where
    type AttrAllowedOps TlsCertificatePrivateKeyPropertyInfo = '[ 'AttrConstruct, 'AttrClear]
    type AttrBaseTypeConstraint TlsCertificatePrivateKeyPropertyInfo = IsTlsCertificate
    type AttrSetTypeConstraint TlsCertificatePrivateKeyPropertyInfo = (~) ByteString
    type AttrTransferTypeConstraint TlsCertificatePrivateKeyPropertyInfo = (~) ByteString
    type AttrTransferType TlsCertificatePrivateKeyPropertyInfo = ByteString
    type AttrGetType TlsCertificatePrivateKeyPropertyInfo = ()
    type AttrLabel TlsCertificatePrivateKeyPropertyInfo = "private-key"
    type AttrOrigin TlsCertificatePrivateKeyPropertyInfo = TlsCertificate
    attrGet = undefined
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructTlsCertificatePrivateKey
    attrClear = undefined
#endif

-- VVV Prop "private-key-pem"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Construct a `GValueConstruct` with valid value for the “@private-key-pem@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTlsCertificatePrivateKeyPem :: (IsTlsCertificate o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructTlsCertificatePrivateKeyPem :: Text -> m (GValueConstruct o)
constructTlsCertificatePrivateKeyPem val :: Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString "private-key-pem" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data TlsCertificatePrivateKeyPemPropertyInfo
instance AttrInfo TlsCertificatePrivateKeyPemPropertyInfo where
    type AttrAllowedOps TlsCertificatePrivateKeyPemPropertyInfo = '[ 'AttrConstruct, 'AttrClear]
    type AttrBaseTypeConstraint TlsCertificatePrivateKeyPemPropertyInfo = IsTlsCertificate
    type AttrSetTypeConstraint TlsCertificatePrivateKeyPemPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint TlsCertificatePrivateKeyPemPropertyInfo = (~) T.Text
    type AttrTransferType TlsCertificatePrivateKeyPemPropertyInfo = T.Text
    type AttrGetType TlsCertificatePrivateKeyPemPropertyInfo = ()
    type AttrLabel TlsCertificatePrivateKeyPemPropertyInfo = "private-key-pem"
    type AttrOrigin TlsCertificatePrivateKeyPemPropertyInfo = TlsCertificate
    attrGet = undefined
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructTlsCertificatePrivateKeyPem
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList TlsCertificate
type instance O.AttributeList TlsCertificate = TlsCertificateAttributeList
type TlsCertificateAttributeList = ('[ '("certificate", TlsCertificateCertificatePropertyInfo), '("certificatePem", TlsCertificateCertificatePemPropertyInfo), '("issuer", TlsCertificateIssuerPropertyInfo), '("privateKey", TlsCertificatePrivateKeyPropertyInfo), '("privateKeyPem", TlsCertificatePrivateKeyPemPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
tlsCertificateCertificate :: AttrLabelProxy "certificate"
tlsCertificateCertificate = AttrLabelProxy

tlsCertificateCertificatePem :: AttrLabelProxy "certificatePem"
tlsCertificateCertificatePem = AttrLabelProxy

tlsCertificateIssuer :: AttrLabelProxy "issuer"
tlsCertificateIssuer = AttrLabelProxy

tlsCertificatePrivateKey :: AttrLabelProxy "privateKey"
tlsCertificatePrivateKey = AttrLabelProxy

tlsCertificatePrivateKeyPem :: AttrLabelProxy "privateKeyPem"
tlsCertificatePrivateKeyPem = AttrLabelProxy

#endif

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

#endif

-- method TlsCertificate::new_from_file
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TBasicType TFileName
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "file containing a PEM-encoded certificate to import"
--                 , 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_certificate_new_from_file" g_tls_certificate_new_from_file :: 
    CString ->                              -- file : TBasicType TFileName
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr TlsCertificate)

-- | Creates a t'GI.Gio.Objects.TlsCertificate.TlsCertificate' from the PEM-encoded data in /@file@/. The
-- returned certificate will be the first certificate found in /@file@/. As
-- of GLib 2.44, if /@file@/ contains more certificates it will try to load
-- a certificate chain. All certificates will be verified in the order
-- found (top-level certificate should be the last one in the file) and
-- the t'GI.Gio.Objects.TlsCertificate.TlsCertificate':@/issuer/@ property of each certificate will be set
-- accordingly if the verification succeeds. If any certificate in the
-- chain cannot be verified, the first certificate in the file will
-- still be returned.
-- 
-- If /@file@/ cannot be read or parsed, the function will return 'P.Nothing' and
-- set /@error@/. Otherwise, this behaves like
-- 'GI.Gio.Objects.TlsCertificate.tlsCertificateNewFromPem'.
-- 
-- /Since: 2.28/
tlsCertificateNewFromFile ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    [Char]
    -- ^ /@file@/: file containing a PEM-encoded certificate to import
    -> m TlsCertificate
    -- ^ __Returns:__ the new certificate, or 'P.Nothing' on error /(Can throw 'Data.GI.Base.GError.GError')/
tlsCertificateNewFromFile :: String -> m TlsCertificate
tlsCertificateNewFromFile file :: String
file = 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
    CString
file' <- String -> IO CString
stringToCString String
file
    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
$ CString -> Ptr (Ptr GError) -> IO (Ptr TlsCertificate)
g_tls_certificate_new_from_file CString
file'
        Text -> Ptr TlsCertificate -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "tlsCertificateNewFromFile" 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
TlsCertificate) Ptr TlsCertificate
result
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
file'
        TlsCertificate -> IO TlsCertificate
forall (m :: * -> *) a. Monad m => a -> m a
return TlsCertificate
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
file'
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method TlsCertificate::new_from_files
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "cert_file"
--           , argType = TBasicType TFileName
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "file containing one or more PEM-encoded\n    certificates to import"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key_file"
--           , argType = TBasicType TFileName
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "file containing a PEM-encoded private key\n    to import"
--                 , 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_certificate_new_from_files" g_tls_certificate_new_from_files :: 
    CString ->                              -- cert_file : TBasicType TFileName
    CString ->                              -- key_file : TBasicType TFileName
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr TlsCertificate)

-- | Creates a t'GI.Gio.Objects.TlsCertificate.TlsCertificate' from the PEM-encoded data in /@certFile@/
-- and /@keyFile@/. The returned certificate will be the first certificate
-- found in /@certFile@/. As of GLib 2.44, if /@certFile@/ contains more
-- certificates it will try to load a certificate chain. All
-- certificates will be verified in the order found (top-level
-- certificate should be the last one in the file) and the
-- t'GI.Gio.Objects.TlsCertificate.TlsCertificate':@/issuer/@ property of each certificate will be set
-- accordingly if the verification succeeds. If any certificate in the
-- chain cannot be verified, the first certificate in the file will
-- still be returned.
-- 
-- If either file cannot be read or parsed, the function will return
-- 'P.Nothing' and set /@error@/. Otherwise, this behaves like
-- 'GI.Gio.Objects.TlsCertificate.tlsCertificateNewFromPem'.
-- 
-- /Since: 2.28/
tlsCertificateNewFromFiles ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    [Char]
    -- ^ /@certFile@/: file containing one or more PEM-encoded
    --     certificates to import
    -> [Char]
    -- ^ /@keyFile@/: file containing a PEM-encoded private key
    --     to import
    -> m TlsCertificate
    -- ^ __Returns:__ the new certificate, or 'P.Nothing' on error /(Can throw 'Data.GI.Base.GError.GError')/
tlsCertificateNewFromFiles :: String -> String -> m TlsCertificate
tlsCertificateNewFromFiles certFile :: String
certFile keyFile :: String
keyFile = 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
    CString
certFile' <- String -> IO CString
stringToCString String
certFile
    CString
keyFile' <- String -> IO CString
stringToCString String
keyFile
    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
$ CString -> CString -> Ptr (Ptr GError) -> IO (Ptr TlsCertificate)
g_tls_certificate_new_from_files CString
certFile' CString
keyFile'
        Text -> Ptr TlsCertificate -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "tlsCertificateNewFromFiles" 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
TlsCertificate) Ptr TlsCertificate
result
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
certFile'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
keyFile'
        TlsCertificate -> IO TlsCertificate
forall (m :: * -> *) a. Monad m => a -> m a
return TlsCertificate
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
certFile'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
keyFile'
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method TlsCertificate::new_from_pem
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "data"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "PEM-encoded certificate data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the length of @data, or -1 if it's 0-terminated."
--                 , 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_certificate_new_from_pem" g_tls_certificate_new_from_pem :: 
    CString ->                              -- data : TBasicType TUTF8
    Int64 ->                                -- length : TBasicType TInt64
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr TlsCertificate)

-- | Creates a t'GI.Gio.Objects.TlsCertificate.TlsCertificate' from the PEM-encoded data in /@data@/. If
-- /@data@/ includes both a certificate and a private key, then the
-- returned certificate will include the private key data as well. (See
-- the t'GI.Gio.Objects.TlsCertificate.TlsCertificate':@/private-key-pem/@ property for information about
-- supported formats.)
-- 
-- The returned certificate will be the first certificate found in
-- /@data@/. As of GLib 2.44, if /@data@/ contains more certificates it will
-- try to load a certificate chain. All certificates will be verified in
-- the order found (top-level certificate should be the last one in the
-- file) and the t'GI.Gio.Objects.TlsCertificate.TlsCertificate':@/issuer/@ property of each certificate
-- will be set accordingly if the verification succeeds. If any
-- certificate in the chain cannot be verified, the first certificate in
-- the file will still be returned.
-- 
-- /Since: 2.28/
tlsCertificateNewFromPem ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@data@/: PEM-encoded certificate data
    -> Int64
    -- ^ /@length@/: the length of /@data@/, or -1 if it\'s 0-terminated.
    -> m TlsCertificate
    -- ^ __Returns:__ the new certificate, or 'P.Nothing' if /@data@/ is invalid /(Can throw 'Data.GI.Base.GError.GError')/
tlsCertificateNewFromPem :: Text -> Int64 -> m TlsCertificate
tlsCertificateNewFromPem data_ :: Text
data_ length_ :: Int64
length_ = 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
    CString
data_' <- Text -> IO CString
textToCString Text
data_
    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
$ CString -> Int64 -> Ptr (Ptr GError) -> IO (Ptr TlsCertificate)
g_tls_certificate_new_from_pem CString
data_' Int64
length_
        Text -> Ptr TlsCertificate -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "tlsCertificateNewFromPem" 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
TlsCertificate) Ptr TlsCertificate
result
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
data_'
        TlsCertificate -> IO TlsCertificate
forall (m :: * -> *) a. Monad m => a -> m a
return TlsCertificate
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
data_'
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method TlsCertificate::get_issuer
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "cert"
--           , 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
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gio" , name = "TlsCertificate" })
-- throws : False
-- Skip return : False

foreign import ccall "g_tls_certificate_get_issuer" g_tls_certificate_get_issuer :: 
    Ptr TlsCertificate ->                   -- cert : TInterface (Name {namespace = "Gio", name = "TlsCertificate"})
    IO (Ptr TlsCertificate)

-- | Gets the t'GI.Gio.Objects.TlsCertificate.TlsCertificate' representing /@cert@/\'s issuer, if known
-- 
-- /Since: 2.28/
tlsCertificateGetIssuer ::
    (B.CallStack.HasCallStack, MonadIO m, IsTlsCertificate a) =>
    a
    -- ^ /@cert@/: a t'GI.Gio.Objects.TlsCertificate.TlsCertificate'
    -> m TlsCertificate
    -- ^ __Returns:__ The certificate of /@cert@/\'s issuer,
    -- or 'P.Nothing' if /@cert@/ is self-signed or signed with an unknown
    -- certificate.
tlsCertificateGetIssuer :: a -> m TlsCertificate
tlsCertificateGetIssuer cert :: a
cert = 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 TlsCertificate
cert' <- a -> IO (Ptr TlsCertificate)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
cert
    Ptr TlsCertificate
result <- Ptr TlsCertificate -> IO (Ptr TlsCertificate)
g_tls_certificate_get_issuer Ptr TlsCertificate
cert'
    Text -> Ptr TlsCertificate -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "tlsCertificateGetIssuer" 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
newObject ManagedPtr TlsCertificate -> TlsCertificate
TlsCertificate) Ptr TlsCertificate
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
cert
    TlsCertificate -> IO TlsCertificate
forall (m :: * -> *) a. Monad m => a -> m a
return TlsCertificate
result'

#if defined(ENABLE_OVERLOADING)
data TlsCertificateGetIssuerMethodInfo
instance (signature ~ (m TlsCertificate), MonadIO m, IsTlsCertificate a) => O.MethodInfo TlsCertificateGetIssuerMethodInfo a signature where
    overloadedMethod = tlsCertificateGetIssuer

#endif

-- method TlsCertificate::is_same
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "cert_one"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "TlsCertificate" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "first certificate to compare"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cert_two"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "TlsCertificate" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "second certificate to compare"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "g_tls_certificate_is_same" g_tls_certificate_is_same :: 
    Ptr TlsCertificate ->                   -- cert_one : TInterface (Name {namespace = "Gio", name = "TlsCertificate"})
    Ptr TlsCertificate ->                   -- cert_two : TInterface (Name {namespace = "Gio", name = "TlsCertificate"})
    IO CInt

-- | Check if two t'GI.Gio.Objects.TlsCertificate.TlsCertificate' objects represent the same certificate.
-- The raw DER byte data of the two certificates are checked for equality.
-- This has the effect that two certificates may compare equal even if
-- their t'GI.Gio.Objects.TlsCertificate.TlsCertificate':@/issuer/@, t'GI.Gio.Objects.TlsCertificate.TlsCertificate':@/private-key/@, or
-- t'GI.Gio.Objects.TlsCertificate.TlsCertificate':@/private-key-pem/@ properties differ.
-- 
-- /Since: 2.34/
tlsCertificateIsSame ::
    (B.CallStack.HasCallStack, MonadIO m, IsTlsCertificate a, IsTlsCertificate b) =>
    a
    -- ^ /@certOne@/: first certificate to compare
    -> b
    -- ^ /@certTwo@/: second certificate to compare
    -> m Bool
    -- ^ __Returns:__ whether the same or not
tlsCertificateIsSame :: a -> b -> m Bool
tlsCertificateIsSame certOne :: a
certOne certTwo :: b
certTwo = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr TlsCertificate
certOne' <- a -> IO (Ptr TlsCertificate)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
certOne
    Ptr TlsCertificate
certTwo' <- b -> IO (Ptr TlsCertificate)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
certTwo
    CInt
result <- Ptr TlsCertificate -> Ptr TlsCertificate -> IO CInt
g_tls_certificate_is_same Ptr TlsCertificate
certOne' Ptr TlsCertificate
certTwo'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
certOne
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
certTwo
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data TlsCertificateIsSameMethodInfo
instance (signature ~ (b -> m Bool), MonadIO m, IsTlsCertificate a, IsTlsCertificate b) => O.MethodInfo TlsCertificateIsSameMethodInfo a signature where
    overloadedMethod = tlsCertificateIsSame

#endif

-- method TlsCertificate::verify
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "cert"
--           , 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 = "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 = "trusted_ca"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "TlsCertificate" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the certificate of a trusted authority"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Gio" , name = "TlsCertificateFlags" })
-- throws : False
-- Skip return : False

foreign import ccall "g_tls_certificate_verify" g_tls_certificate_verify :: 
    Ptr TlsCertificate ->                   -- cert : TInterface (Name {namespace = "Gio", name = "TlsCertificate"})
    Ptr Gio.SocketConnectable.SocketConnectable -> -- identity : TInterface (Name {namespace = "Gio", name = "SocketConnectable"})
    Ptr TlsCertificate ->                   -- trusted_ca : TInterface (Name {namespace = "Gio", name = "TlsCertificate"})
    IO CUInt

-- | This verifies /@cert@/ and returns a set of t'GI.Gio.Flags.TlsCertificateFlags'
-- indicating any problems found with it. This can be used to verify a
-- certificate outside the context of making a connection, or to
-- check a certificate against a CA that is not part of the system
-- CA database.
-- 
-- If /@identity@/ is not 'P.Nothing', /@cert@/\'s name(s) will be compared against
-- it, and 'GI.Gio.Flags.TlsCertificateFlagsBadIdentity' will be set in the return
-- value if it does not match. If /@identity@/ is 'P.Nothing', that bit will
-- never be set in the return value.
-- 
-- If /@trustedCa@/ is not 'P.Nothing', then /@cert@/ (or one of the certificates
-- in its chain) must be signed by it, or else
-- 'GI.Gio.Flags.TlsCertificateFlagsUnknownCa' will be set in the return value. If
-- /@trustedCa@/ is 'P.Nothing', that bit will never be set in the return
-- value.
-- 
-- (All other t'GI.Gio.Flags.TlsCertificateFlags' values will always be set or unset
-- as appropriate.)
-- 
-- /Since: 2.28/
tlsCertificateVerify ::
    (B.CallStack.HasCallStack, MonadIO m, IsTlsCertificate a, Gio.SocketConnectable.IsSocketConnectable b, IsTlsCertificate c) =>
    a
    -- ^ /@cert@/: a t'GI.Gio.Objects.TlsCertificate.TlsCertificate'
    -> Maybe (b)
    -- ^ /@identity@/: the expected peer identity
    -> Maybe (c)
    -- ^ /@trustedCa@/: the certificate of a trusted authority
    -> m [Gio.Flags.TlsCertificateFlags]
    -- ^ __Returns:__ the appropriate t'GI.Gio.Flags.TlsCertificateFlags'
tlsCertificateVerify :: a -> Maybe b -> Maybe c -> m [TlsCertificateFlags]
tlsCertificateVerify cert :: a
cert identity :: Maybe b
identity trustedCa :: Maybe c
trustedCa = 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 TlsCertificate
cert' <- a -> IO (Ptr TlsCertificate)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
cert
    Ptr SocketConnectable
maybeIdentity <- case Maybe b
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 :: b
jIdentity -> do
            Ptr SocketConnectable
jIdentity' <- b -> IO (Ptr SocketConnectable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jIdentity
            Ptr SocketConnectable -> IO (Ptr SocketConnectable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr SocketConnectable
jIdentity'
    Ptr TlsCertificate
maybeTrustedCa <- case Maybe c
trustedCa of
        Nothing -> Ptr TlsCertificate -> IO (Ptr TlsCertificate)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TlsCertificate
forall a. Ptr a
nullPtr
        Just jTrustedCa :: c
jTrustedCa -> do
            Ptr TlsCertificate
jTrustedCa' <- c -> IO (Ptr TlsCertificate)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jTrustedCa
            Ptr TlsCertificate -> IO (Ptr TlsCertificate)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TlsCertificate
jTrustedCa'
    CUInt
result <- Ptr TlsCertificate
-> Ptr SocketConnectable -> Ptr TlsCertificate -> IO CUInt
g_tls_certificate_verify Ptr TlsCertificate
cert' Ptr SocketConnectable
maybeIdentity Ptr TlsCertificate
maybeTrustedCa
    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
cert
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
identity 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
trustedCa c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    [TlsCertificateFlags] -> IO [TlsCertificateFlags]
forall (m :: * -> *) a. Monad m => a -> m a
return [TlsCertificateFlags]
result'

#if defined(ENABLE_OVERLOADING)
data TlsCertificateVerifyMethodInfo
instance (signature ~ (Maybe (b) -> Maybe (c) -> m [Gio.Flags.TlsCertificateFlags]), MonadIO m, IsTlsCertificate a, Gio.SocketConnectable.IsSocketConnectable b, IsTlsCertificate c) => O.MethodInfo TlsCertificateVerifyMethodInfo a signature where
    overloadedMethod = tlsCertificateVerify

#endif

-- method TlsCertificate::list_new_from_file
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TBasicType TFileName
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "file containing PEM-encoded certificates to import"
--                 , 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_certificate_list_new_from_file" g_tls_certificate_list_new_from_file :: 
    CString ->                              -- file : TBasicType TFileName
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr (GList (Ptr TlsCertificate)))

-- | Creates one or more @/GTlsCertificates/@ from the PEM-encoded
-- data in /@file@/. If /@file@/ cannot be read or parsed, the function will
-- return 'P.Nothing' and set /@error@/. If /@file@/ does not contain any
-- PEM-encoded certificates, this will return an empty list and not
-- set /@error@/.
-- 
-- /Since: 2.28/
tlsCertificateListNewFromFile ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    [Char]
    -- ^ /@file@/: file containing PEM-encoded certificates to import
    -> m [TlsCertificate]
    -- ^ __Returns:__ a
    -- t'GI.GLib.Structs.List.List' containing t'GI.Gio.Objects.TlsCertificate.TlsCertificate' objects. You must free the list
    -- and its contents when you are done with it. /(Can throw 'Data.GI.Base.GError.GError')/
tlsCertificateListNewFromFile :: String -> m [TlsCertificate]
tlsCertificateListNewFromFile file :: String
file = 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
    CString
file' <- String -> IO CString
stringToCString String
file
    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
$ CString
-> Ptr (Ptr GError) -> IO (Ptr (GList (Ptr TlsCertificate)))
g_tls_certificate_list_new_from_file CString
file'
        [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
TlsCertificate) [Ptr TlsCertificate]
result'
        Ptr (GList (Ptr TlsCertificate)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr TlsCertificate))
result
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
file'
        [TlsCertificate] -> IO [TlsCertificate]
forall (m :: * -> *) a. Monad m => a -> m a
return [TlsCertificate]
result''
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
file'
     )

#if defined(ENABLE_OVERLOADING)
#endif