#if DERIVE_STORABLE_PLUGIN
{-# OPTIONS_GHC -fplugin=Foreign.Storable.Generic.Plugin #-}
#endif

-- | Internal module, not subject to PVP.
module Rustls.Internal.FFI
  ( ConstPtr (..),
    ConstCString,

    -- * Client

    -- ** Config
    ClientConfig,
    ClientConfigBuilder,
    clientConfigBuilderNewCustom,
    clientConfigBuilderFree,
    clientConfigBuilderBuild,
    clientConfigFree,
    clientConfigBuilderSetALPNProtocols,
    clientConfigBuilderSetEnableSNI,
    clientConfigBuilderSetCertifiedKey,
    clientConfigBuilderLoadRootsFromFile,
    clientConfigBuilderUseRoots,

    -- ** Connection
    clientConnectionNew,
    serverConnectionNew,

    -- * Server

    -- ** Config
    ServerConfig,
    ServerConfigBuilder,
    serverConfigBuilderNewCustom,
    serverConfigBuilderFree,
    serverConfigBuilderBuild,
    serverConfigFree,
    serverConfigBuilderSetALPNProtocols,
    serverConfigBuilderSetIgnoreClientOrder,
    serverConfigBuilderSetCertifiedKeys,
    ClientCertVerifier,
    clientCertVerifierNew,
    clientCertVerifierFree,
    serverConfigBuilderSetClientVerifier,
    ClientCertVerifierOptional,
    clientCertVerifierOptionalNew,
    clientCertVerifierOptionalFree,
    serverConfigBuilderSetClientVerifierOptional,

    -- * Certificate stuff
    CertifiedKey,
    certifiedKeyBuild,
    certifiedKeyFree,
    Certificate,
    certificateGetDER,

    -- * Connection
    Connection,
    connectionFree,

    -- ** Read/write

    -- *** Read
    ReadCallback,
    mkReadCallback,
    connectionWantsRead,
    connectionRead,
    connectionReadTls,

    -- *** Write
    WriteCallback,
    mkWriteCallback,
    connectionWantsWrite,
    connectionWrite,
    connectionWriteTls,

    -- ** Misc
    connectionProcessNewPackets,
    connectionIsHandshaking,
    connectionSendCloseNotify,
    connectionSetBufferLimit,
    connectionGetALPNProtocol,
    connectionGetProtocolVersion,
    connectionGetNegotiatedCipherSuite,
    serverConnectionGetSNIHostname,
    connectionGetPeerCertificate,

    -- ** Logging
    connectionSetLogCallback,
    LogCallback,
    mkLogCallback,
    LogParams (..),
    LogLevel (..),

    -- * Misc
    Str (..),
    SliceBytes (..),
    hsVersion,
    Userdata,

    -- ** 'Result'
    Result (..),
    resultIsCertError,
    errorMsg,

    -- *** Some values
    resultOk,
    resultInsufficientSize,

    -- ** 'IOResult'
    IOResult (..),
    ioResultOk,
    ioResultErr,

    -- ** TLS params
    SupportedCipherSuite,
    allCipherSuites,
    allCipherSuitesLen,
    defaultCipherSuites,
    defaultCipherSuitesLen,
    supportedCipherSuiteGetSuite,
    hsSupportedCipherSuiteGetName,
    TLSVersion (..),
    pattern TLS12,
    pattern TLS13,
    allVersions,
    allVersionsLen,
    defaultVersions,
    defaultVersionsLen,

    -- ** Root cert store
    RootCertStore,
    rootCertStoreNew,
    rootCertStoreAddPEM,
    rootCertStoreFree,
  )
where

import Data.Word
import Foreign
import Foreign.C
import Foreign.Storable.Generic
import GHC.Generics (Generic)

#if MIN_VERSION_base(4,18,0)
import Foreign.C.ConstPtr
#else
newtype ConstPtr a = ConstPtr {forall a. ConstPtr a -> Ptr a
unConstPtr :: Ptr a}
  deriving newtype (Int -> ConstPtr a -> ShowS
[ConstPtr a] -> ShowS
ConstPtr a -> String
(Int -> ConstPtr a -> ShowS)
-> (ConstPtr a -> String)
-> ([ConstPtr a] -> ShowS)
-> Show (ConstPtr a)
forall a. Int -> ConstPtr a -> ShowS
forall a. [ConstPtr a] -> ShowS
forall a. ConstPtr a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> ConstPtr a -> ShowS
showsPrec :: Int -> ConstPtr a -> ShowS
$cshow :: forall a. ConstPtr a -> String
show :: ConstPtr a -> String
$cshowList :: forall a. [ConstPtr a] -> ShowS
showList :: [ConstPtr a] -> ShowS
Show, ConstPtr a -> ConstPtr a -> Bool
(ConstPtr a -> ConstPtr a -> Bool)
-> (ConstPtr a -> ConstPtr a -> Bool) -> Eq (ConstPtr a)
forall a. ConstPtr a -> ConstPtr a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. ConstPtr a -> ConstPtr a -> Bool
== :: ConstPtr a -> ConstPtr a -> Bool
$c/= :: forall a. ConstPtr a -> ConstPtr a -> Bool
/= :: ConstPtr a -> ConstPtr a -> Bool
Eq, Ptr (ConstPtr a) -> IO (ConstPtr a)
Ptr (ConstPtr a) -> Int -> IO (ConstPtr a)
Ptr (ConstPtr a) -> Int -> ConstPtr a -> IO ()
Ptr (ConstPtr a) -> ConstPtr a -> IO ()
ConstPtr a -> Int
(ConstPtr a -> Int)
-> (ConstPtr a -> Int)
-> (Ptr (ConstPtr a) -> Int -> IO (ConstPtr a))
-> (Ptr (ConstPtr a) -> Int -> ConstPtr a -> IO ())
-> (forall b. Ptr b -> Int -> IO (ConstPtr a))
-> (forall b. Ptr b -> Int -> ConstPtr a -> IO ())
-> (Ptr (ConstPtr a) -> IO (ConstPtr a))
-> (Ptr (ConstPtr a) -> ConstPtr a -> IO ())
-> Storable (ConstPtr a)
forall b. Ptr b -> Int -> IO (ConstPtr a)
forall b. Ptr b -> Int -> ConstPtr a -> IO ()
forall a. Ptr (ConstPtr a) -> IO (ConstPtr a)
forall a. Ptr (ConstPtr a) -> Int -> IO (ConstPtr a)
forall a. Ptr (ConstPtr a) -> Int -> ConstPtr a -> IO ()
forall a. Ptr (ConstPtr a) -> ConstPtr a -> IO ()
forall a. ConstPtr a -> Int
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
forall a b. Ptr b -> Int -> IO (ConstPtr a)
forall a b. Ptr b -> Int -> ConstPtr a -> IO ()
$csizeOf :: forall a. ConstPtr a -> Int
sizeOf :: ConstPtr a -> Int
$calignment :: forall a. ConstPtr a -> Int
alignment :: ConstPtr a -> Int
$cpeekElemOff :: forall a. Ptr (ConstPtr a) -> Int -> IO (ConstPtr a)
peekElemOff :: Ptr (ConstPtr a) -> Int -> IO (ConstPtr a)
$cpokeElemOff :: forall a. Ptr (ConstPtr a) -> Int -> ConstPtr a -> IO ()
pokeElemOff :: Ptr (ConstPtr a) -> Int -> ConstPtr a -> IO ()
$cpeekByteOff :: forall a b. Ptr b -> Int -> IO (ConstPtr a)
peekByteOff :: forall b. Ptr b -> Int -> IO (ConstPtr a)
$cpokeByteOff :: forall a b. Ptr b -> Int -> ConstPtr a -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> ConstPtr a -> IO ()
$cpeek :: forall a. Ptr (ConstPtr a) -> IO (ConstPtr a)
peek :: Ptr (ConstPtr a) -> IO (ConstPtr a)
$cpoke :: forall a. Ptr (ConstPtr a) -> ConstPtr a -> IO ()
poke :: Ptr (ConstPtr a) -> ConstPtr a -> IO ()
Storable)
#endif

type ConstCString = ConstPtr CChar

-- Misc

data {-# CTYPE "rustls.h" "rustls_str" #-} Str = Str CString CSize
  deriving stock ((forall x. Str -> Rep Str x)
-> (forall x. Rep Str x -> Str) -> Generic Str
forall x. Rep Str x -> Str
forall x. Str -> Rep Str x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Str -> Rep Str x
from :: forall x. Str -> Rep Str x
$cto :: forall x. Rep Str x -> Str
to :: forall x. Rep Str x -> Str
Generic)
  deriving anyclass (Str -> Int
(Str -> Int)
-> (Str -> Int)
-> (forall b. Ptr b -> Int -> IO Str)
-> (forall b. Ptr b -> Int -> Str -> IO ())
-> GStorable Str
forall b. Ptr b -> Int -> IO Str
forall b. Ptr b -> Int -> Str -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> GStorable a
$cgsizeOf :: Str -> Int
gsizeOf :: Str -> Int
$cgalignment :: Str -> Int
galignment :: Str -> Int
$cgpeekByteOff :: forall b. Ptr b -> Int -> IO Str
gpeekByteOff :: forall b. Ptr b -> Int -> IO Str
$cgpokeByteOff :: forall b. Ptr b -> Int -> Str -> IO ()
gpokeByteOff :: forall b. Ptr b -> Int -> Str -> IO ()
GStorable)

data {-# CTYPE "rustls.h" "rustls_slice_bytes" #-} SliceBytes = SliceBytes (Ptr Word8) CSize
  deriving stock ((forall x. SliceBytes -> Rep SliceBytes x)
-> (forall x. Rep SliceBytes x -> SliceBytes) -> Generic SliceBytes
forall x. Rep SliceBytes x -> SliceBytes
forall x. SliceBytes -> Rep SliceBytes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SliceBytes -> Rep SliceBytes x
from :: forall x. SliceBytes -> Rep SliceBytes x
$cto :: forall x. Rep SliceBytes x -> SliceBytes
to :: forall x. Rep SliceBytes x -> SliceBytes
Generic)
  deriving anyclass (SliceBytes -> Int
(SliceBytes -> Int)
-> (SliceBytes -> Int)
-> (forall b. Ptr b -> Int -> IO SliceBytes)
-> (forall b. Ptr b -> Int -> SliceBytes -> IO ())
-> GStorable SliceBytes
forall b. Ptr b -> Int -> IO SliceBytes
forall b. Ptr b -> Int -> SliceBytes -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> GStorable a
$cgsizeOf :: SliceBytes -> Int
gsizeOf :: SliceBytes -> Int
$cgalignment :: SliceBytes -> Int
galignment :: SliceBytes -> Int
$cgpeekByteOff :: forall b. Ptr b -> Int -> IO SliceBytes
gpeekByteOff :: forall b. Ptr b -> Int -> IO SliceBytes
$cgpokeByteOff :: forall b. Ptr b -> Int -> SliceBytes -> IO ()
gpokeByteOff :: forall b. Ptr b -> Int -> SliceBytes -> IO ()
GStorable)

foreign import capi unsafe "hs_rustls.h hs_rustls_version"
  hsVersion :: Ptr Str -> IO ()

newtype {-# CTYPE "rustls.h" "rustls_result" #-} Result = Result Word32
  deriving stock (Int -> Result -> ShowS
[Result] -> ShowS
Result -> String
(Int -> Result -> ShowS)
-> (Result -> String) -> ([Result] -> ShowS) -> Show Result
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Result -> ShowS
showsPrec :: Int -> Result -> ShowS
$cshow :: Result -> String
show :: Result -> String
$cshowList :: [Result] -> ShowS
showList :: [Result] -> ShowS
Show, Result -> Result -> Bool
(Result -> Result -> Bool)
-> (Result -> Result -> Bool) -> Eq Result
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Result -> Result -> Bool
== :: Result -> Result -> Bool
$c/= :: Result -> Result -> Bool
/= :: Result -> Result -> Bool
Eq, Eq Result
Eq Result
-> (Result -> Result -> Ordering)
-> (Result -> Result -> Bool)
-> (Result -> Result -> Bool)
-> (Result -> Result -> Bool)
-> (Result -> Result -> Bool)
-> (Result -> Result -> Result)
-> (Result -> Result -> Result)
-> Ord Result
Result -> Result -> Bool
Result -> Result -> Ordering
Result -> Result -> Result
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Result -> Result -> Ordering
compare :: Result -> Result -> Ordering
$c< :: Result -> Result -> Bool
< :: Result -> Result -> Bool
$c<= :: Result -> Result -> Bool
<= :: Result -> Result -> Bool
$c> :: Result -> Result -> Bool
> :: Result -> Result -> Bool
$c>= :: Result -> Result -> Bool
>= :: Result -> Result -> Bool
$cmax :: Result -> Result -> Result
max :: Result -> Result -> Result
$cmin :: Result -> Result -> Result
min :: Result -> Result -> Result
Ord)

foreign import capi "rustls.h value RUSTLS_RESULT_OK"
  resultOk :: Result

foreign import capi "rustls.h value RUSTLS_RESULT_INSUFFICIENT_SIZE"
  resultInsufficientSize :: Result

foreign import capi unsafe "rustls.h rustls_result_is_cert_error"
  resultIsCertError :: Result -> CBool

foreign import capi unsafe "rustls.h rustls_error"
  errorMsg :: Result -> CString -> CSize -> Ptr CSize -> IO ()

newtype {-# CTYPE "rustls.h" "rustls_io_result" #-} IOResult = IOResult CInt
  deriving stock (IOResult -> IOResult -> Bool
(IOResult -> IOResult -> Bool)
-> (IOResult -> IOResult -> Bool) -> Eq IOResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IOResult -> IOResult -> Bool
== :: IOResult -> IOResult -> Bool
$c/= :: IOResult -> IOResult -> Bool
/= :: IOResult -> IOResult -> Bool
Eq)

ioResultOk :: IOResult
ioResultOk :: IOResult
ioResultOk = CInt -> IOResult
IOResult CInt
0

ioResultErr :: IOResult
ioResultErr :: IOResult
ioResultErr = CInt -> IOResult
IOResult CInt
1

-- | (Unused) userdata.
data Userdata

-- Client

data {-# CTYPE "rustls.h" "rustls_client_config" #-} ClientConfig

data {-# CTYPE "rustls.h" "rustls_client_config_builder" #-} ClientConfigBuilder

foreign import capi unsafe "rustls.h rustls_client_config_builder_new_custom"
  clientConfigBuilderNewCustom ::
    ConstPtr (ConstPtr SupportedCipherSuite) ->
    CSize ->
    ConstPtr TLSVersion ->
    CSize ->
    Ptr (Ptr ClientConfigBuilder) ->
    IO Result

foreign import capi unsafe "rustls.h rustls_client_config_builder_free"
  clientConfigBuilderFree :: Ptr ClientConfigBuilder -> IO ()

foreign import capi unsafe "rustls.h rustls_client_config_builder_build"
  clientConfigBuilderBuild :: Ptr ClientConfigBuilder -> IO (ConstPtr ClientConfig)

foreign import capi unsafe "rustls.h &rustls_client_config_free"
  clientConfigFree :: FinalizerPtr ClientConfig

foreign import capi unsafe "rustls.h rustls_client_connection_new"
  clientConnectionNew ::
    ConstPtr ClientConfig ->
    -- | Hostname.
    ConstCString ->
    Ptr (Ptr Connection) ->
    IO Result

foreign import capi unsafe "rustls.h rustls_client_config_builder_load_roots_from_file"
  clientConfigBuilderLoadRootsFromFile :: Ptr ClientConfigBuilder -> ConstCString -> IO Result

data {-# CTYPE "rustls.h" "rustls_root_cert_store" #-} RootCertStore

foreign import capi unsafe "rustls.h rustls_root_cert_store_new"
  rootCertStoreNew :: IO (Ptr RootCertStore)

foreign import capi unsafe "rustls.h rustls_root_cert_store_add_pem"
  rootCertStoreAddPEM :: Ptr RootCertStore -> ConstPtr Word8 -> CSize -> CBool -> IO Result

foreign import capi unsafe "rustls.h rustls_root_cert_store_free"
  rootCertStoreFree :: Ptr RootCertStore -> IO ()

foreign import capi unsafe "rustls.h rustls_client_config_builder_use_roots"
  clientConfigBuilderUseRoots :: Ptr ClientConfigBuilder -> ConstPtr RootCertStore -> IO Result

foreign import capi unsafe "rustls.h rustls_client_config_builder_set_alpn_protocols"
  clientConfigBuilderSetALPNProtocols ::
    Ptr ClientConfigBuilder -> ConstPtr SliceBytes -> CSize -> IO Result

foreign import capi unsafe "rustls.h rustls_client_config_builder_set_enable_sni"
  clientConfigBuilderSetEnableSNI :: Ptr ClientConfigBuilder -> CBool -> IO ()

foreign import capi unsafe "rustls.h rustls_client_config_builder_set_certified_key"
  clientConfigBuilderSetCertifiedKey ::
    Ptr ClientConfigBuilder -> ConstPtr (ConstPtr CertifiedKey) -> CSize -> IO Result

-- TODO add callback-based cert validation?

-- Server
data {-# CTYPE "rustls.h" "rustls_server_config" #-} ServerConfig

data {-# CTYPE "rustls.h" "rustls_server_config_builder" #-} ServerConfigBuilder

foreign import capi unsafe "rustls.h rustls_server_config_builder_new_custom"
  serverConfigBuilderNewCustom ::
    ConstPtr (ConstPtr SupportedCipherSuite) ->
    CSize ->
    ConstPtr TLSVersion ->
    CSize ->
    Ptr (Ptr ServerConfigBuilder) ->
    IO Result

foreign import capi unsafe "rustls.h rustls_server_config_builder_free"
  serverConfigBuilderFree :: Ptr ServerConfigBuilder -> IO ()

foreign import capi unsafe "rustls.h rustls_server_config_builder_build"
  serverConfigBuilderBuild :: Ptr ServerConfigBuilder -> IO (ConstPtr ServerConfig)

foreign import capi unsafe "rustls.h &rustls_server_config_free"
  serverConfigFree :: FinalizerPtr ServerConfig

foreign import capi unsafe "rustls.h rustls_server_connection_new"
  serverConnectionNew :: ConstPtr ServerConfig -> Ptr (Ptr Connection) -> IO Result

foreign import capi unsafe "rustls.h rustls_server_config_builder_set_alpn_protocols"
  serverConfigBuilderSetALPNProtocols ::
    Ptr ServerConfigBuilder -> ConstPtr SliceBytes -> CSize -> IO Result

foreign import capi unsafe "rustls.h rustls_server_config_builder_set_ignore_client_order"
  serverConfigBuilderSetIgnoreClientOrder :: Ptr ServerConfigBuilder -> CBool -> IO Result

foreign import capi unsafe "rustls.h rustls_server_config_builder_set_certified_keys"
  serverConfigBuilderSetCertifiedKeys ::
    Ptr ServerConfigBuilder -> ConstPtr (ConstPtr CertifiedKey) -> CSize -> IO Result

data {-# CTYPE "rustls.h" "rustls_client_cert_verifier" #-} ClientCertVerifier

foreign import capi unsafe "rustls.h rustls_client_cert_verifier_new"
  clientCertVerifierNew :: ConstPtr RootCertStore -> IO (ConstPtr ClientCertVerifier)

foreign import capi unsafe "rustls.h rustls_client_cert_verifier_free"
  clientCertVerifierFree :: ConstPtr ClientCertVerifier -> IO ()

foreign import capi unsafe "rustls.h rustls_server_config_builder_set_client_verifier"
  serverConfigBuilderSetClientVerifier ::
    Ptr ServerConfigBuilder -> ConstPtr ClientCertVerifier -> IO ()

data {-# CTYPE "rustls.h" "rustls_client_cert_verifier_optional" #-} ClientCertVerifierOptional

foreign import capi unsafe "rustls.h rustls_client_cert_verifier_optional_new"
  clientCertVerifierOptionalNew ::
    ConstPtr RootCertStore -> IO (ConstPtr ClientCertVerifierOptional)

foreign import capi unsafe "rustls.h rustls_client_cert_verifier_optional_free"
  clientCertVerifierOptionalFree :: ConstPtr ClientCertVerifierOptional -> IO ()

foreign import capi unsafe "rustls.h rustls_server_config_builder_set_client_verifier_optional"
  serverConfigBuilderSetClientVerifierOptional ::
    Ptr ServerConfigBuilder -> ConstPtr ClientCertVerifierOptional -> IO ()

-- add custom session persistence functions?

-- connection

data {-# CTYPE "rustls.h" "rustls_connection" #-} Connection

foreign import capi unsafe "rustls.h rustls_connection_free"
  connectionFree :: Ptr Connection -> IO ()

type LogCallback = Ptr Userdata -> ConstPtr LogParams -> IO ()

foreign import ccall "wrapper"
  mkLogCallback :: LogCallback -> IO (FunPtr LogCallback)

newtype LogLevel = LogLevel CSize
  deriving stock (Int -> LogLevel -> ShowS
[LogLevel] -> ShowS
LogLevel -> String
(Int -> LogLevel -> ShowS)
-> (LogLevel -> String) -> ([LogLevel] -> ShowS) -> Show LogLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LogLevel -> ShowS
showsPrec :: Int -> LogLevel -> ShowS
$cshow :: LogLevel -> String
show :: LogLevel -> String
$cshowList :: [LogLevel] -> ShowS
showList :: [LogLevel] -> ShowS
Show, LogLevel -> LogLevel -> Bool
(LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool) -> Eq LogLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LogLevel -> LogLevel -> Bool
== :: LogLevel -> LogLevel -> Bool
$c/= :: LogLevel -> LogLevel -> Bool
/= :: LogLevel -> LogLevel -> Bool
Eq)
  deriving newtype (Ptr LogLevel -> IO LogLevel
Ptr LogLevel -> Int -> IO LogLevel
Ptr LogLevel -> Int -> LogLevel -> IO ()
Ptr LogLevel -> LogLevel -> IO ()
LogLevel -> Int
(LogLevel -> Int)
-> (LogLevel -> Int)
-> (Ptr LogLevel -> Int -> IO LogLevel)
-> (Ptr LogLevel -> Int -> LogLevel -> IO ())
-> (forall b. Ptr b -> Int -> IO LogLevel)
-> (forall b. Ptr b -> Int -> LogLevel -> IO ())
-> (Ptr LogLevel -> IO LogLevel)
-> (Ptr LogLevel -> LogLevel -> IO ())
-> Storable LogLevel
forall b. Ptr b -> Int -> IO LogLevel
forall b. Ptr b -> Int -> LogLevel -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: LogLevel -> Int
sizeOf :: LogLevel -> Int
$calignment :: LogLevel -> Int
alignment :: LogLevel -> Int
$cpeekElemOff :: Ptr LogLevel -> Int -> IO LogLevel
peekElemOff :: Ptr LogLevel -> Int -> IO LogLevel
$cpokeElemOff :: Ptr LogLevel -> Int -> LogLevel -> IO ()
pokeElemOff :: Ptr LogLevel -> Int -> LogLevel -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO LogLevel
peekByteOff :: forall b. Ptr b -> Int -> IO LogLevel
$cpokeByteOff :: forall b. Ptr b -> Int -> LogLevel -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> LogLevel -> IO ()
$cpeek :: Ptr LogLevel -> IO LogLevel
peek :: Ptr LogLevel -> IO LogLevel
$cpoke :: Ptr LogLevel -> LogLevel -> IO ()
poke :: Ptr LogLevel -> LogLevel -> IO ()
Storable)

data LogParams = LogParams
  { LogParams -> LogLevel
rustlsLogParamsLevel :: LogLevel,
    LogParams -> Str
rustlsLogParamsMessage :: Str
  }
  deriving stock ((forall x. LogParams -> Rep LogParams x)
-> (forall x. Rep LogParams x -> LogParams) -> Generic LogParams
forall x. Rep LogParams x -> LogParams
forall x. LogParams -> Rep LogParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LogParams -> Rep LogParams x
from :: forall x. LogParams -> Rep LogParams x
$cto :: forall x. Rep LogParams x -> LogParams
to :: forall x. Rep LogParams x -> LogParams
Generic)
  deriving anyclass (LogParams -> Int
(LogParams -> Int)
-> (LogParams -> Int)
-> (forall b. Ptr b -> Int -> IO LogParams)
-> (forall b. Ptr b -> Int -> LogParams -> IO ())
-> GStorable LogParams
forall b. Ptr b -> Int -> IO LogParams
forall b. Ptr b -> Int -> LogParams -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> GStorable a
$cgsizeOf :: LogParams -> Int
gsizeOf :: LogParams -> Int
$cgalignment :: LogParams -> Int
galignment :: LogParams -> Int
$cgpeekByteOff :: forall b. Ptr b -> Int -> IO LogParams
gpeekByteOff :: forall b. Ptr b -> Int -> IO LogParams
$cgpokeByteOff :: forall b. Ptr b -> Int -> LogParams -> IO ()
gpokeByteOff :: forall b. Ptr b -> Int -> LogParams -> IO ()
GStorable)

foreign import capi unsafe "rustls.h rustls_connection_set_log_callback"
  connectionSetLogCallback :: Ptr Connection -> FunPtr LogCallback -> IO ()

foreign import capi unsafe "rustls.h rustls_connection_is_handshaking"
  connectionIsHandshaking :: ConstPtr Connection -> IO CBool

foreign import capi unsafe "rustls.h rustls_connection_get_alpn_protocol"
  connectionGetALPNProtocol :: ConstPtr Connection -> Ptr (ConstPtr Word8) -> Ptr CSize -> IO ()

foreign import capi unsafe "rustls.h rustls_connection_get_protocol_version"
  connectionGetProtocolVersion :: ConstPtr Connection -> IO TLSVersion

foreign import capi unsafe "rustls.h rustls_connection_get_negotiated_ciphersuite"
  connectionGetNegotiatedCipherSuite :: ConstPtr Connection -> IO (ConstPtr SupportedCipherSuite)

foreign import capi unsafe "rustls.h rustls_server_connection_get_sni_hostname"
  serverConnectionGetSNIHostname :: ConstPtr Connection -> Ptr Word8 -> CSize -> Ptr CSize -> IO Result

foreign import capi unsafe "rustls.h rustls_connection_get_peer_certificate"
  connectionGetPeerCertificate :: ConstPtr Connection -> CSize -> IO (ConstPtr Certificate)

-- connection read

type ReadCallback = Ptr Userdata -> Ptr Word8 -> CSize -> Ptr CSize -> IO IOResult

foreign import ccall "wrapper"
  mkReadCallback :: ReadCallback -> IO (FunPtr ReadCallback)

foreign import capi "rustls.h rustls_connection_read_tls"
  connectionReadTls ::
    Ptr Connection -> FunPtr ReadCallback -> Ptr Userdata -> Ptr CSize -> IO IOResult

foreign import capi "rustls.h rustls_connection_read"
  connectionRead :: Ptr Connection -> Ptr Word8 -> CSize -> Ptr CSize -> IO Result

foreign import capi unsafe "rustls.h rustls_connection_wants_read"
  connectionWantsRead :: ConstPtr Connection -> IO CBool

-- connection write

type WriteCallback = Ptr Userdata -> ConstPtr Word8 -> CSize -> Ptr CSize -> IO IOResult

foreign import ccall "wrapper"
  mkWriteCallback :: WriteCallback -> IO (FunPtr WriteCallback)

foreign import capi "rustls.h rustls_connection_write_tls"
  connectionWriteTls ::
    Ptr Connection -> FunPtr WriteCallback -> Ptr Userdata -> Ptr CSize -> IO IOResult

foreign import capi "rustls.h rustls_connection_write"
  connectionWrite :: Ptr Connection -> Ptr Word8 -> CSize -> Ptr CSize -> IO Result

foreign import capi unsafe "rustls.h rustls_connection_wants_write"
  connectionWantsWrite :: ConstPtr Connection -> IO CBool

-- misc

foreign import capi "rustls.h rustls_connection_process_new_packets"
  connectionProcessNewPackets :: Ptr Connection -> IO Result

foreign import capi "rustls.h rustls_connection_send_close_notify"
  connectionSendCloseNotify :: Ptr Connection -> IO ()

-- TODO high level bindings?
foreign import capi unsafe "rustls.h rustls_connection_set_buffer_limit"
  connectionSetBufferLimit :: Ptr Connection -> CSize -> IO ()

data {-# CTYPE "rustls.h" "rustls_certified_key" #-} CertifiedKey

foreign import capi unsafe "rustls.h rustls_certified_key_build"
  certifiedKeyBuild ::
    ConstPtr Word8 -> CSize -> ConstPtr Word8 -> CSize -> Ptr (ConstPtr CertifiedKey) -> IO Result

foreign import capi unsafe "rustls.h rustls_certified_key_free"
  certifiedKeyFree :: ConstPtr CertifiedKey -> IO ()

data {-# CTYPE "rustls.h" "rustls_certificate" #-} Certificate

foreign import capi unsafe "rustls.h rustls_certificate_get_der"
  certificateGetDER :: ConstPtr Certificate -> Ptr (ConstPtr Word8) -> Ptr CSize -> IO Result

-- TLS params

data {-# CTYPE "rustls.h" "rustls_supported_ciphersuite" #-} SupportedCipherSuite

foreign import capi "rustls.h value RUSTLS_ALL_CIPHER_SUITES"
  allCipherSuites :: ConstPtr (Ptr SupportedCipherSuite)

foreign import capi "rustls.h value RUSTLS_ALL_CIPHER_SUITES_LEN"
  allCipherSuitesLen :: CSize

foreign import capi "rustls.h value RUSTLS_DEFAULT_CIPHER_SUITES"
  defaultCipherSuites :: ConstPtr (ConstPtr SupportedCipherSuite)

foreign import capi "rustls.h value RUSTLS_DEFAULT_CIPHER_SUITES_LEN"
  defaultCipherSuitesLen :: CSize

foreign import capi unsafe "rustls.h rustls_supported_ciphersuite_get_suite"
  supportedCipherSuiteGetSuite :: ConstPtr SupportedCipherSuite -> Word16

foreign import capi unsafe "hs_rustls.h hs_rustls_supported_ciphersuite_get_name"
  hsSupportedCipherSuiteGetName :: ConstPtr SupportedCipherSuite -> Ptr Str -> IO ()

-- | A TLS protocol version supported by Rustls.
newtype {-# CTYPE "stdint.h" "uint16_t" #-} TLSVersion = TLSVersion
  { TLSVersion -> Word16
unTLSVersion :: Word16
  }
  deriving stock (Int -> TLSVersion -> ShowS
[TLSVersion] -> ShowS
TLSVersion -> String
(Int -> TLSVersion -> ShowS)
-> (TLSVersion -> String)
-> ([TLSVersion] -> ShowS)
-> Show TLSVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TLSVersion -> ShowS
showsPrec :: Int -> TLSVersion -> ShowS
$cshow :: TLSVersion -> String
show :: TLSVersion -> String
$cshowList :: [TLSVersion] -> ShowS
showList :: [TLSVersion] -> ShowS
Show, TLSVersion -> TLSVersion -> Bool
(TLSVersion -> TLSVersion -> Bool)
-> (TLSVersion -> TLSVersion -> Bool) -> Eq TLSVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TLSVersion -> TLSVersion -> Bool
== :: TLSVersion -> TLSVersion -> Bool
$c/= :: TLSVersion -> TLSVersion -> Bool
/= :: TLSVersion -> TLSVersion -> Bool
Eq, Eq TLSVersion
Eq TLSVersion
-> (TLSVersion -> TLSVersion -> Ordering)
-> (TLSVersion -> TLSVersion -> Bool)
-> (TLSVersion -> TLSVersion -> Bool)
-> (TLSVersion -> TLSVersion -> Bool)
-> (TLSVersion -> TLSVersion -> Bool)
-> (TLSVersion -> TLSVersion -> TLSVersion)
-> (TLSVersion -> TLSVersion -> TLSVersion)
-> Ord TLSVersion
TLSVersion -> TLSVersion -> Bool
TLSVersion -> TLSVersion -> Ordering
TLSVersion -> TLSVersion -> TLSVersion
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TLSVersion -> TLSVersion -> Ordering
compare :: TLSVersion -> TLSVersion -> Ordering
$c< :: TLSVersion -> TLSVersion -> Bool
< :: TLSVersion -> TLSVersion -> Bool
$c<= :: TLSVersion -> TLSVersion -> Bool
<= :: TLSVersion -> TLSVersion -> Bool
$c> :: TLSVersion -> TLSVersion -> Bool
> :: TLSVersion -> TLSVersion -> Bool
$c>= :: TLSVersion -> TLSVersion -> Bool
>= :: TLSVersion -> TLSVersion -> Bool
$cmax :: TLSVersion -> TLSVersion -> TLSVersion
max :: TLSVersion -> TLSVersion -> TLSVersion
$cmin :: TLSVersion -> TLSVersion -> TLSVersion
min :: TLSVersion -> TLSVersion -> TLSVersion
Ord)
  deriving newtype (Ptr TLSVersion -> IO TLSVersion
Ptr TLSVersion -> Int -> IO TLSVersion
Ptr TLSVersion -> Int -> TLSVersion -> IO ()
Ptr TLSVersion -> TLSVersion -> IO ()
TLSVersion -> Int
(TLSVersion -> Int)
-> (TLSVersion -> Int)
-> (Ptr TLSVersion -> Int -> IO TLSVersion)
-> (Ptr TLSVersion -> Int -> TLSVersion -> IO ())
-> (forall b. Ptr b -> Int -> IO TLSVersion)
-> (forall b. Ptr b -> Int -> TLSVersion -> IO ())
-> (Ptr TLSVersion -> IO TLSVersion)
-> (Ptr TLSVersion -> TLSVersion -> IO ())
-> Storable TLSVersion
forall b. Ptr b -> Int -> IO TLSVersion
forall b. Ptr b -> Int -> TLSVersion -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: TLSVersion -> Int
sizeOf :: TLSVersion -> Int
$calignment :: TLSVersion -> Int
alignment :: TLSVersion -> Int
$cpeekElemOff :: Ptr TLSVersion -> Int -> IO TLSVersion
peekElemOff :: Ptr TLSVersion -> Int -> IO TLSVersion
$cpokeElemOff :: Ptr TLSVersion -> Int -> TLSVersion -> IO ()
pokeElemOff :: Ptr TLSVersion -> Int -> TLSVersion -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO TLSVersion
peekByteOff :: forall b. Ptr b -> Int -> IO TLSVersion
$cpokeByteOff :: forall b. Ptr b -> Int -> TLSVersion -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> TLSVersion -> IO ()
$cpeek :: Ptr TLSVersion -> IO TLSVersion
peek :: Ptr TLSVersion -> IO TLSVersion
$cpoke :: Ptr TLSVersion -> TLSVersion -> IO ()
poke :: Ptr TLSVersion -> TLSVersion -> IO ()
Storable)

pattern TLS12, TLS13 :: TLSVersion
pattern $mTLS12 :: forall {r}. TLSVersion -> ((# #) -> r) -> ((# #) -> r) -> r
$bTLS12 :: TLSVersion
TLS12 = TLSVersion 0x0303
pattern $mTLS13 :: forall {r}. TLSVersion -> ((# #) -> r) -> ((# #) -> r) -> r
$bTLS13 :: TLSVersion
TLS13 = TLSVersion 0x0304

foreign import capi "rustls.h value RUSTLS_ALL_VERSIONS"
  allVersions :: ConstPtr TLSVersion

foreign import capi "rustls.h value RUSTLS_ALL_VERSIONS_LEN"
  allVersionsLen :: CSize

foreign import capi "rustls.h value RUSTLS_DEFAULT_VERSIONS"
  defaultVersions :: ConstPtr TLSVersion

foreign import capi "rustls.h value RUSTLS_DEFAULT_VERSIONS_LEN"
  defaultVersionsLen :: CSize