{-# LANGUAGE ForeignFunctionInterface #-}
module Network.Protocol.TLS.GNU.Foreign where
import Foreign
import Foreign.C
newtype ReturnCode = ReturnCode { ReturnCode -> CInt
unRC :: CInt }
deriving (Int -> ReturnCode -> ShowS
[ReturnCode] -> ShowS
ReturnCode -> String
(Int -> ReturnCode -> ShowS)
-> (ReturnCode -> String)
-> ([ReturnCode] -> ShowS)
-> Show ReturnCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReturnCode] -> ShowS
$cshowList :: [ReturnCode] -> ShowS
show :: ReturnCode -> String
$cshow :: ReturnCode -> String
showsPrec :: Int -> ReturnCode -> ShowS
$cshowsPrec :: Int -> ReturnCode -> ShowS
Show, ReturnCode -> ReturnCode -> Bool
(ReturnCode -> ReturnCode -> Bool)
-> (ReturnCode -> ReturnCode -> Bool) -> Eq ReturnCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReturnCode -> ReturnCode -> Bool
$c/= :: ReturnCode -> ReturnCode -> Bool
== :: ReturnCode -> ReturnCode -> Bool
$c== :: ReturnCode -> ReturnCode -> Bool
Eq)
newtype CipherAlgorithm = CipherAlgorithm CInt
deriving (Int -> CipherAlgorithm -> ShowS
[CipherAlgorithm] -> ShowS
CipherAlgorithm -> String
(Int -> CipherAlgorithm -> ShowS)
-> (CipherAlgorithm -> String)
-> ([CipherAlgorithm] -> ShowS)
-> Show CipherAlgorithm
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CipherAlgorithm] -> ShowS
$cshowList :: [CipherAlgorithm] -> ShowS
show :: CipherAlgorithm -> String
$cshow :: CipherAlgorithm -> String
showsPrec :: Int -> CipherAlgorithm -> ShowS
$cshowsPrec :: Int -> CipherAlgorithm -> ShowS
Show, CipherAlgorithm -> CipherAlgorithm -> Bool
(CipherAlgorithm -> CipherAlgorithm -> Bool)
-> (CipherAlgorithm -> CipherAlgorithm -> Bool)
-> Eq CipherAlgorithm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CipherAlgorithm -> CipherAlgorithm -> Bool
$c/= :: CipherAlgorithm -> CipherAlgorithm -> Bool
== :: CipherAlgorithm -> CipherAlgorithm -> Bool
$c== :: CipherAlgorithm -> CipherAlgorithm -> Bool
Eq)
newtype KXAlgorithm = KXAlgorithm CInt
deriving (Int -> KXAlgorithm -> ShowS
[KXAlgorithm] -> ShowS
KXAlgorithm -> String
(Int -> KXAlgorithm -> ShowS)
-> (KXAlgorithm -> String)
-> ([KXAlgorithm] -> ShowS)
-> Show KXAlgorithm
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KXAlgorithm] -> ShowS
$cshowList :: [KXAlgorithm] -> ShowS
show :: KXAlgorithm -> String
$cshow :: KXAlgorithm -> String
showsPrec :: Int -> KXAlgorithm -> ShowS
$cshowsPrec :: Int -> KXAlgorithm -> ShowS
Show, KXAlgorithm -> KXAlgorithm -> Bool
(KXAlgorithm -> KXAlgorithm -> Bool)
-> (KXAlgorithm -> KXAlgorithm -> Bool) -> Eq KXAlgorithm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KXAlgorithm -> KXAlgorithm -> Bool
$c/= :: KXAlgorithm -> KXAlgorithm -> Bool
== :: KXAlgorithm -> KXAlgorithm -> Bool
$c== :: KXAlgorithm -> KXAlgorithm -> Bool
Eq)
newtype ParamsType = ParamsType CInt
deriving (Int -> ParamsType -> ShowS
[ParamsType] -> ShowS
ParamsType -> String
(Int -> ParamsType -> ShowS)
-> (ParamsType -> String)
-> ([ParamsType] -> ShowS)
-> Show ParamsType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParamsType] -> ShowS
$cshowList :: [ParamsType] -> ShowS
show :: ParamsType -> String
$cshow :: ParamsType -> String
showsPrec :: Int -> ParamsType -> ShowS
$cshowsPrec :: Int -> ParamsType -> ShowS
Show, ParamsType -> ParamsType -> Bool
(ParamsType -> ParamsType -> Bool)
-> (ParamsType -> ParamsType -> Bool) -> Eq ParamsType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParamsType -> ParamsType -> Bool
$c/= :: ParamsType -> ParamsType -> Bool
== :: ParamsType -> ParamsType -> Bool
$c== :: ParamsType -> ParamsType -> Bool
Eq)
newtype CredentialsType = CredentialsType CInt
deriving (Int -> CredentialsType -> ShowS
[CredentialsType] -> ShowS
CredentialsType -> String
(Int -> CredentialsType -> ShowS)
-> (CredentialsType -> String)
-> ([CredentialsType] -> ShowS)
-> Show CredentialsType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CredentialsType] -> ShowS
$cshowList :: [CredentialsType] -> ShowS
show :: CredentialsType -> String
$cshow :: CredentialsType -> String
showsPrec :: Int -> CredentialsType -> ShowS
$cshowsPrec :: Int -> CredentialsType -> ShowS
Show, CredentialsType -> CredentialsType -> Bool
(CredentialsType -> CredentialsType -> Bool)
-> (CredentialsType -> CredentialsType -> Bool)
-> Eq CredentialsType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CredentialsType -> CredentialsType -> Bool
$c/= :: CredentialsType -> CredentialsType -> Bool
== :: CredentialsType -> CredentialsType -> Bool
$c== :: CredentialsType -> CredentialsType -> Bool
Eq)
newtype MACAlgorithm = MACAlgorithm CInt
deriving (Int -> MACAlgorithm -> ShowS
[MACAlgorithm] -> ShowS
MACAlgorithm -> String
(Int -> MACAlgorithm -> ShowS)
-> (MACAlgorithm -> String)
-> ([MACAlgorithm] -> ShowS)
-> Show MACAlgorithm
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MACAlgorithm] -> ShowS
$cshowList :: [MACAlgorithm] -> ShowS
show :: MACAlgorithm -> String
$cshow :: MACAlgorithm -> String
showsPrec :: Int -> MACAlgorithm -> ShowS
$cshowsPrec :: Int -> MACAlgorithm -> ShowS
Show, MACAlgorithm -> MACAlgorithm -> Bool
(MACAlgorithm -> MACAlgorithm -> Bool)
-> (MACAlgorithm -> MACAlgorithm -> Bool) -> Eq MACAlgorithm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MACAlgorithm -> MACAlgorithm -> Bool
$c/= :: MACAlgorithm -> MACAlgorithm -> Bool
== :: MACAlgorithm -> MACAlgorithm -> Bool
$c== :: MACAlgorithm -> MACAlgorithm -> Bool
Eq)
newtype DigestAlgorithm = DigestAlgorithm CInt
deriving (Int -> DigestAlgorithm -> ShowS
[DigestAlgorithm] -> ShowS
DigestAlgorithm -> String
(Int -> DigestAlgorithm -> ShowS)
-> (DigestAlgorithm -> String)
-> ([DigestAlgorithm] -> ShowS)
-> Show DigestAlgorithm
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DigestAlgorithm] -> ShowS
$cshowList :: [DigestAlgorithm] -> ShowS
show :: DigestAlgorithm -> String
$cshow :: DigestAlgorithm -> String
showsPrec :: Int -> DigestAlgorithm -> ShowS
$cshowsPrec :: Int -> DigestAlgorithm -> ShowS
Show, DigestAlgorithm -> DigestAlgorithm -> Bool
(DigestAlgorithm -> DigestAlgorithm -> Bool)
-> (DigestAlgorithm -> DigestAlgorithm -> Bool)
-> Eq DigestAlgorithm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DigestAlgorithm -> DigestAlgorithm -> Bool
$c/= :: DigestAlgorithm -> DigestAlgorithm -> Bool
== :: DigestAlgorithm -> DigestAlgorithm -> Bool
$c== :: DigestAlgorithm -> DigestAlgorithm -> Bool
Eq)
newtype CompressionMethod = CompressionMethod CInt
deriving (Int -> CompressionMethod -> ShowS
[CompressionMethod] -> ShowS
CompressionMethod -> String
(Int -> CompressionMethod -> ShowS)
-> (CompressionMethod -> String)
-> ([CompressionMethod] -> ShowS)
-> Show CompressionMethod
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompressionMethod] -> ShowS
$cshowList :: [CompressionMethod] -> ShowS
show :: CompressionMethod -> String
$cshow :: CompressionMethod -> String
showsPrec :: Int -> CompressionMethod -> ShowS
$cshowsPrec :: Int -> CompressionMethod -> ShowS
Show, CompressionMethod -> CompressionMethod -> Bool
(CompressionMethod -> CompressionMethod -> Bool)
-> (CompressionMethod -> CompressionMethod -> Bool)
-> Eq CompressionMethod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompressionMethod -> CompressionMethod -> Bool
$c/= :: CompressionMethod -> CompressionMethod -> Bool
== :: CompressionMethod -> CompressionMethod -> Bool
$c== :: CompressionMethod -> CompressionMethod -> Bool
Eq)
newtype ConnectionEnd = ConnectionEnd CInt
deriving (Int -> ConnectionEnd -> ShowS
[ConnectionEnd] -> ShowS
ConnectionEnd -> String
(Int -> ConnectionEnd -> ShowS)
-> (ConnectionEnd -> String)
-> ([ConnectionEnd] -> ShowS)
-> Show ConnectionEnd
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConnectionEnd] -> ShowS
$cshowList :: [ConnectionEnd] -> ShowS
show :: ConnectionEnd -> String
$cshow :: ConnectionEnd -> String
showsPrec :: Int -> ConnectionEnd -> ShowS
$cshowsPrec :: Int -> ConnectionEnd -> ShowS
Show, ConnectionEnd -> ConnectionEnd -> Bool
(ConnectionEnd -> ConnectionEnd -> Bool)
-> (ConnectionEnd -> ConnectionEnd -> Bool) -> Eq ConnectionEnd
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConnectionEnd -> ConnectionEnd -> Bool
$c/= :: ConnectionEnd -> ConnectionEnd -> Bool
== :: ConnectionEnd -> ConnectionEnd -> Bool
$c== :: ConnectionEnd -> ConnectionEnd -> Bool
Eq)
newtype AlertLevel = AlertLevel CInt
deriving (Int -> AlertLevel -> ShowS
[AlertLevel] -> ShowS
AlertLevel -> String
(Int -> AlertLevel -> ShowS)
-> (AlertLevel -> String)
-> ([AlertLevel] -> ShowS)
-> Show AlertLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AlertLevel] -> ShowS
$cshowList :: [AlertLevel] -> ShowS
show :: AlertLevel -> String
$cshow :: AlertLevel -> String
showsPrec :: Int -> AlertLevel -> ShowS
$cshowsPrec :: Int -> AlertLevel -> ShowS
Show, AlertLevel -> AlertLevel -> Bool
(AlertLevel -> AlertLevel -> Bool)
-> (AlertLevel -> AlertLevel -> Bool) -> Eq AlertLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AlertLevel -> AlertLevel -> Bool
$c/= :: AlertLevel -> AlertLevel -> Bool
== :: AlertLevel -> AlertLevel -> Bool
$c== :: AlertLevel -> AlertLevel -> Bool
Eq)
newtype AlertDescription = AlertDescription CInt
deriving (Int -> AlertDescription -> ShowS
[AlertDescription] -> ShowS
AlertDescription -> String
(Int -> AlertDescription -> ShowS)
-> (AlertDescription -> String)
-> ([AlertDescription] -> ShowS)
-> Show AlertDescription
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AlertDescription] -> ShowS
$cshowList :: [AlertDescription] -> ShowS
show :: AlertDescription -> String
$cshow :: AlertDescription -> String
showsPrec :: Int -> AlertDescription -> ShowS
$cshowsPrec :: Int -> AlertDescription -> ShowS
Show, AlertDescription -> AlertDescription -> Bool
(AlertDescription -> AlertDescription -> Bool)
-> (AlertDescription -> AlertDescription -> Bool)
-> Eq AlertDescription
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AlertDescription -> AlertDescription -> Bool
$c/= :: AlertDescription -> AlertDescription -> Bool
== :: AlertDescription -> AlertDescription -> Bool
$c== :: AlertDescription -> AlertDescription -> Bool
Eq)
newtype HandshakeDescription = HandshakeDescription CInt
deriving (Int -> HandshakeDescription -> ShowS
[HandshakeDescription] -> ShowS
HandshakeDescription -> String
(Int -> HandshakeDescription -> ShowS)
-> (HandshakeDescription -> String)
-> ([HandshakeDescription] -> ShowS)
-> Show HandshakeDescription
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HandshakeDescription] -> ShowS
$cshowList :: [HandshakeDescription] -> ShowS
show :: HandshakeDescription -> String
$cshow :: HandshakeDescription -> String
showsPrec :: Int -> HandshakeDescription -> ShowS
$cshowsPrec :: Int -> HandshakeDescription -> ShowS
Show, HandshakeDescription -> HandshakeDescription -> Bool
(HandshakeDescription -> HandshakeDescription -> Bool)
-> (HandshakeDescription -> HandshakeDescription -> Bool)
-> Eq HandshakeDescription
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HandshakeDescription -> HandshakeDescription -> Bool
$c/= :: HandshakeDescription -> HandshakeDescription -> Bool
== :: HandshakeDescription -> HandshakeDescription -> Bool
$c== :: HandshakeDescription -> HandshakeDescription -> Bool
Eq)
newtype CertificateStatus = CertificateStatus CInt
deriving (Int -> CertificateStatus -> ShowS
[CertificateStatus] -> ShowS
CertificateStatus -> String
(Int -> CertificateStatus -> ShowS)
-> (CertificateStatus -> String)
-> ([CertificateStatus] -> ShowS)
-> Show CertificateStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CertificateStatus] -> ShowS
$cshowList :: [CertificateStatus] -> ShowS
show :: CertificateStatus -> String
$cshow :: CertificateStatus -> String
showsPrec :: Int -> CertificateStatus -> ShowS
$cshowsPrec :: Int -> CertificateStatus -> ShowS
Show, CertificateStatus -> CertificateStatus -> Bool
(CertificateStatus -> CertificateStatus -> Bool)
-> (CertificateStatus -> CertificateStatus -> Bool)
-> Eq CertificateStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CertificateStatus -> CertificateStatus -> Bool
$c/= :: CertificateStatus -> CertificateStatus -> Bool
== :: CertificateStatus -> CertificateStatus -> Bool
$c== :: CertificateStatus -> CertificateStatus -> Bool
Eq)
newtype CertificateRequest = CertificateRequest CInt
deriving (Int -> CertificateRequest -> ShowS
[CertificateRequest] -> ShowS
CertificateRequest -> String
(Int -> CertificateRequest -> ShowS)
-> (CertificateRequest -> String)
-> ([CertificateRequest] -> ShowS)
-> Show CertificateRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CertificateRequest] -> ShowS
$cshowList :: [CertificateRequest] -> ShowS
show :: CertificateRequest -> String
$cshow :: CertificateRequest -> String
showsPrec :: Int -> CertificateRequest -> ShowS
$cshowsPrec :: Int -> CertificateRequest -> ShowS
Show, CertificateRequest -> CertificateRequest -> Bool
(CertificateRequest -> CertificateRequest -> Bool)
-> (CertificateRequest -> CertificateRequest -> Bool)
-> Eq CertificateRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CertificateRequest -> CertificateRequest -> Bool
$c/= :: CertificateRequest -> CertificateRequest -> Bool
== :: CertificateRequest -> CertificateRequest -> Bool
$c== :: CertificateRequest -> CertificateRequest -> Bool
Eq)
newtype OpenPGPCrtStatus = OpenPGPCrtStatus CInt
deriving (Int -> OpenPGPCrtStatus -> ShowS
[OpenPGPCrtStatus] -> ShowS
OpenPGPCrtStatus -> String
(Int -> OpenPGPCrtStatus -> ShowS)
-> (OpenPGPCrtStatus -> String)
-> ([OpenPGPCrtStatus] -> ShowS)
-> Show OpenPGPCrtStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpenPGPCrtStatus] -> ShowS
$cshowList :: [OpenPGPCrtStatus] -> ShowS
show :: OpenPGPCrtStatus -> String
$cshow :: OpenPGPCrtStatus -> String
showsPrec :: Int -> OpenPGPCrtStatus -> ShowS
$cshowsPrec :: Int -> OpenPGPCrtStatus -> ShowS
Show, OpenPGPCrtStatus -> OpenPGPCrtStatus -> Bool
(OpenPGPCrtStatus -> OpenPGPCrtStatus -> Bool)
-> (OpenPGPCrtStatus -> OpenPGPCrtStatus -> Bool)
-> Eq OpenPGPCrtStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpenPGPCrtStatus -> OpenPGPCrtStatus -> Bool
$c/= :: OpenPGPCrtStatus -> OpenPGPCrtStatus -> Bool
== :: OpenPGPCrtStatus -> OpenPGPCrtStatus -> Bool
$c== :: OpenPGPCrtStatus -> OpenPGPCrtStatus -> Bool
Eq)
newtype CloseRequest = CloseRequest CInt
deriving (Int -> CloseRequest -> ShowS
[CloseRequest] -> ShowS
CloseRequest -> String
(Int -> CloseRequest -> ShowS)
-> (CloseRequest -> String)
-> ([CloseRequest] -> ShowS)
-> Show CloseRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CloseRequest] -> ShowS
$cshowList :: [CloseRequest] -> ShowS
show :: CloseRequest -> String
$cshow :: CloseRequest -> String
showsPrec :: Int -> CloseRequest -> ShowS
$cshowsPrec :: Int -> CloseRequest -> ShowS
Show, CloseRequest -> CloseRequest -> Bool
(CloseRequest -> CloseRequest -> Bool)
-> (CloseRequest -> CloseRequest -> Bool) -> Eq CloseRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CloseRequest -> CloseRequest -> Bool
$c/= :: CloseRequest -> CloseRequest -> Bool
== :: CloseRequest -> CloseRequest -> Bool
$c== :: CloseRequest -> CloseRequest -> Bool
Eq)
newtype Protocol = Protocol CInt
deriving (Int -> Protocol -> ShowS
[Protocol] -> ShowS
Protocol -> String
(Int -> Protocol -> ShowS)
-> (Protocol -> String) -> ([Protocol] -> ShowS) -> Show Protocol
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Protocol] -> ShowS
$cshowList :: [Protocol] -> ShowS
show :: Protocol -> String
$cshow :: Protocol -> String
showsPrec :: Int -> Protocol -> ShowS
$cshowsPrec :: Int -> Protocol -> ShowS
Show, Protocol -> Protocol -> Bool
(Protocol -> Protocol -> Bool)
-> (Protocol -> Protocol -> Bool) -> Eq Protocol
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Protocol -> Protocol -> Bool
$c/= :: Protocol -> Protocol -> Bool
== :: Protocol -> Protocol -> Bool
$c== :: Protocol -> Protocol -> Bool
Eq)
newtype CertificateType = CertificateType CInt
deriving (Int -> CertificateType -> ShowS
[CertificateType] -> ShowS
CertificateType -> String
(Int -> CertificateType -> ShowS)
-> (CertificateType -> String)
-> ([CertificateType] -> ShowS)
-> Show CertificateType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CertificateType] -> ShowS
$cshowList :: [CertificateType] -> ShowS
show :: CertificateType -> String
$cshow :: CertificateType -> String
showsPrec :: Int -> CertificateType -> ShowS
$cshowsPrec :: Int -> CertificateType -> ShowS
Show, CertificateType -> CertificateType -> Bool
(CertificateType -> CertificateType -> Bool)
-> (CertificateType -> CertificateType -> Bool)
-> Eq CertificateType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CertificateType -> CertificateType -> Bool
$c/= :: CertificateType -> CertificateType -> Bool
== :: CertificateType -> CertificateType -> Bool
$c== :: CertificateType -> CertificateType -> Bool
Eq)
newtype X509CrtFormat = X509CrtFormat CInt
deriving (Int -> X509CrtFormat -> ShowS
[X509CrtFormat] -> ShowS
X509CrtFormat -> String
(Int -> X509CrtFormat -> ShowS)
-> (X509CrtFormat -> String)
-> ([X509CrtFormat] -> ShowS)
-> Show X509CrtFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [X509CrtFormat] -> ShowS
$cshowList :: [X509CrtFormat] -> ShowS
show :: X509CrtFormat -> String
$cshow :: X509CrtFormat -> String
showsPrec :: Int -> X509CrtFormat -> ShowS
$cshowsPrec :: Int -> X509CrtFormat -> ShowS
Show, X509CrtFormat -> X509CrtFormat -> Bool
(X509CrtFormat -> X509CrtFormat -> Bool)
-> (X509CrtFormat -> X509CrtFormat -> Bool) -> Eq X509CrtFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: X509CrtFormat -> X509CrtFormat -> Bool
$c/= :: X509CrtFormat -> X509CrtFormat -> Bool
== :: X509CrtFormat -> X509CrtFormat -> Bool
$c== :: X509CrtFormat -> X509CrtFormat -> Bool
Eq)
newtype CertificatePrintFormats = CertificatePrintFormats CInt
deriving (Int -> CertificatePrintFormats -> ShowS
[CertificatePrintFormats] -> ShowS
CertificatePrintFormats -> String
(Int -> CertificatePrintFormats -> ShowS)
-> (CertificatePrintFormats -> String)
-> ([CertificatePrintFormats] -> ShowS)
-> Show CertificatePrintFormats
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CertificatePrintFormats] -> ShowS
$cshowList :: [CertificatePrintFormats] -> ShowS
show :: CertificatePrintFormats -> String
$cshow :: CertificatePrintFormats -> String
showsPrec :: Int -> CertificatePrintFormats -> ShowS
$cshowsPrec :: Int -> CertificatePrintFormats -> ShowS
Show, CertificatePrintFormats -> CertificatePrintFormats -> Bool
(CertificatePrintFormats -> CertificatePrintFormats -> Bool)
-> (CertificatePrintFormats -> CertificatePrintFormats -> Bool)
-> Eq CertificatePrintFormats
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CertificatePrintFormats -> CertificatePrintFormats -> Bool
$c/= :: CertificatePrintFormats -> CertificatePrintFormats -> Bool
== :: CertificatePrintFormats -> CertificatePrintFormats -> Bool
$c== :: CertificatePrintFormats -> CertificatePrintFormats -> Bool
Eq)
newtype PKAlgorithm = PKAlgorithm CInt
deriving (Int -> PKAlgorithm -> ShowS
[PKAlgorithm] -> ShowS
PKAlgorithm -> String
(Int -> PKAlgorithm -> ShowS)
-> (PKAlgorithm -> String)
-> ([PKAlgorithm] -> ShowS)
-> Show PKAlgorithm
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PKAlgorithm] -> ShowS
$cshowList :: [PKAlgorithm] -> ShowS
show :: PKAlgorithm -> String
$cshow :: PKAlgorithm -> String
showsPrec :: Int -> PKAlgorithm -> ShowS
$cshowsPrec :: Int -> PKAlgorithm -> ShowS
Show, PKAlgorithm -> PKAlgorithm -> Bool
(PKAlgorithm -> PKAlgorithm -> Bool)
-> (PKAlgorithm -> PKAlgorithm -> Bool) -> Eq PKAlgorithm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PKAlgorithm -> PKAlgorithm -> Bool
$c/= :: PKAlgorithm -> PKAlgorithm -> Bool
== :: PKAlgorithm -> PKAlgorithm -> Bool
$c== :: PKAlgorithm -> PKAlgorithm -> Bool
Eq)
newtype SignAlgorithm = SignAlgorithm CInt
deriving (Int -> SignAlgorithm -> ShowS
[SignAlgorithm] -> ShowS
SignAlgorithm -> String
(Int -> SignAlgorithm -> ShowS)
-> (SignAlgorithm -> String)
-> ([SignAlgorithm] -> ShowS)
-> Show SignAlgorithm
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SignAlgorithm] -> ShowS
$cshowList :: [SignAlgorithm] -> ShowS
show :: SignAlgorithm -> String
$cshow :: SignAlgorithm -> String
showsPrec :: Int -> SignAlgorithm -> ShowS
$cshowsPrec :: Int -> SignAlgorithm -> ShowS
Show, SignAlgorithm -> SignAlgorithm -> Bool
(SignAlgorithm -> SignAlgorithm -> Bool)
-> (SignAlgorithm -> SignAlgorithm -> Bool) -> Eq SignAlgorithm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SignAlgorithm -> SignAlgorithm -> Bool
$c/= :: SignAlgorithm -> SignAlgorithm -> Bool
== :: SignAlgorithm -> SignAlgorithm -> Bool
$c== :: SignAlgorithm -> SignAlgorithm -> Bool
Eq)
newtype Credentials = Credentials (Ptr Credentials)
newtype Transport = Transport (Ptr Transport)
newtype Session = Session (Ptr Session)
newtype DHParams = DHParams (Ptr DHParams)
newtype RSAParams = RSAParams (Ptr RSAParams)
newtype Priority = Priority (Ptr Priority)
newtype Datum = Datum (Ptr Word8, CUInt)
foreign import ccall safe "gnutls_check_version"
gnutls_check_version :: CString -> IO CString
foreign import ccall safe "gnutls_global_init"
gnutls_global_init :: IO ReturnCode
foreign import ccall safe "gnutls_global_deinit"
gnutls_global_deinit :: IO ()
foreign import ccall safe "gnutls_global_set_log_function"
gnutls_global_set_log_function :: FunPtr (CInt -> CString -> IO ()) -> IO ()
foreign import ccall safe "gnutls_global_set_log_level"
gnutls_global_set_log_level :: CInt -> IO ()
foreign import ccall safe "gnutls_error_is_fatal"
gnutls_error_is_fatal :: ReturnCode -> IO CInt
foreign import ccall safe "gnutls_perror"
gnutls_perror :: ReturnCode -> IO ()
foreign import ccall safe "gnutls_strerror"
gnutls_strerror :: ReturnCode -> IO CString
foreign import ccall safe "gnutls_strerror_name"
gnutls_strerror_name :: ReturnCode -> IO CString
foreign import ccall safe "gnutls_init"
gnutls_init :: Ptr (Ptr Session) -> ConnectionEnd -> IO ReturnCode
foreign import ccall safe "gnutls_deinit"
gnutls_deinit :: Session -> IO ()
foreign import ccall safe "gnutls_handshake"
gnutls_handshake :: Session -> IO ReturnCode
foreign import ccall safe "gnutls_rehandshake"
gnutls_rehandshake :: Session -> IO ReturnCode
foreign import ccall safe "gnutls_bye"
gnutls_bye :: Session -> CloseRequest -> IO ReturnCode
foreign import ccall safe "gnutls_set_default_priority"
gnutls_set_default_priority :: Session -> IO ReturnCode
foreign import ccall safe "gnutls_alert_get_name"
gnutls_alert_get_name :: AlertDescription -> IO CString
foreign import ccall safe "gnutls_error_to_alert"
gnutls_error_to_alert :: ReturnCode -> Ptr AlertLevel -> IO AlertDescription
foreign import ccall safe "gnutls_alert_get"
gnutls_alert_get :: Session -> IO AlertDescription
foreign import ccall safe "gnutls_alert_send_appropriate"
gnutls_alert_send_appropriate :: Session -> ReturnCode -> IO ReturnCode
foreign import ccall safe "gnutls_alert_send"
gnutls_alert_send :: Session -> AlertLevel -> AlertDescription -> IO ReturnCode
foreign import ccall safe "gnutls_certificate_allocate_credentials"
gnutls_certificate_allocate_credentials :: Ptr (Ptr Credentials) -> IO ReturnCode
foreign import ccall safe "&gnutls_certificate_free_credentials"
gnutls_certificate_free_credentials_funptr :: FunPtr (Ptr Credentials -> IO ())
foreign import ccall safe "gnutls_certificate_type_get_id"
gnutls_certificate_type_get_id :: CString -> IO CertificateType
foreign import ccall safe "gnutls_certificate_type_get_name"
gnutls_certificate_type_get_name :: CertificateType -> IO CString
foreign import ccall safe "gnutls_certificate_type_get"
gnutls_certificate_type_get :: Session -> IO CertificateType
foreign import ccall safe "gnutls_certificate_type_list"
gnutls_certificate_type_list :: IO (Ptr CertificateType)
foreign import ccall safe "gnutls_credentials_clear"
gnutls_credentials_clear :: Session -> IO ()
foreign import ccall safe "gnutls_credentials_set"
gnutls_credentials_set :: Session -> CredentialsType -> Ptr a -> IO ReturnCode
foreign import ccall safe "gnutls_record_check_pending"
gnutls_record_check_pending :: Session -> IO CSize
foreign import ccall safe "gnutls_record_disable_padding"
gnutls_record_disable_padding :: Session -> IO ()
foreign import ccall safe "gnutls_record_get_direction"
gnutls_record_get_direction :: Session -> IO CInt
foreign import ccall safe "gnutls_record_get_max_size"
gnutls_record_get_max_size :: Session -> IO CSize
foreign import ccall safe "gnutls_record_recv"
gnutls_record_recv :: Session -> Ptr a -> CSize -> IO CSize
foreign import ccall safe "gnutls_record_send"
gnutls_record_send :: Session -> Ptr a -> CSize -> IO CSize
foreign import ccall safe "gnutls_record_set_max_size"
gnutls_record_set_max_size :: Session -> CSize -> IO CSize
type TransportFunc = Transport -> Ptr () -> CSize -> IO CSize
foreign import ccall safe "gnutls_transport_set_push_function"
gnutls_transport_set_push_function :: Session -> FunPtr TransportFunc -> IO ()
foreign import ccall safe "gnutls_transport_set_pull_function"
gnutls_transport_set_pull_function :: Session -> FunPtr TransportFunc -> IO ()
foreign import ccall "wrapper"
wrapTransportFunc :: TransportFunc -> IO (FunPtr TransportFunc)
foreign import ccall safe "gnutls_global_set_mem_functions"
gnutls_global_set_mem_functions
:: FunPtr (CSize -> IO (Ptr ()))
-> FunPtr (CSize -> CSize -> IO (Ptr ()))
-> FunPtr (Ptr () -> IO CInt)
-> FunPtr (Ptr () -> CSize -> IO (Ptr ()))
-> FunPtr (Ptr () -> IO ())
-> IO ()
foreign import ccall safe "gnutls_malloc"
gnutls_malloc :: CSize -> IO (Ptr a)
foreign import ccall safe "gnutls_free"
gnutls_free :: Ptr a -> IO ()
foreign import ccall safe "gnutls_hex2bin"
gnutls_hex2bin :: CString -> CSize -> Ptr Word8 -> Ptr CSize -> IO ReturnCode
foreign import ccall safe "gnutls_hex_decode"
gnutls_hex_decode :: Ptr Datum -> Ptr Word8 -> Ptr CSize -> IO ReturnCode
foreign import ccall safe "gnutls_hex_encode"
gnutls_hex_encode :: Ptr Datum -> CString -> Ptr CSize -> IO ReturnCode