{-# OPTIONS_GHC -Wno-missing-export-lists #-}

-- | Internal module, not subject to PVP.
module Rustls.Internal where

import Control.Concurrent (ThreadId)
import Control.Concurrent.MVar
import Control.Exception qualified as E
import Control.Monad (when)
import Control.Monad.Trans.Reader
import Data.ByteString (ByteString)
import Data.ByteString qualified as B
import Data.ByteString.Unsafe qualified as BU
import Data.Coerce (coerce)
import Data.Functor (void)
import Data.List.NonEmpty (NonEmpty)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Foreign qualified as T
import Foreign hiding (void)
import Foreign.C
import GHC.Generics (Generic)
import Network.Socket qualified as NS
import Rustls.Internal.FFI (ConstPtr (..))
import Rustls.Internal.FFI qualified as FFI
import System.IO.Unsafe (unsafePerformIO)

-- | A cryptography provider for Rustls.
--
-- In particular, this contains the set of supported TLS cipher suites.
newtype CryptoProvider = CryptoProvider
  { CryptoProvider -> ForeignPtr CryptoProvider
unCryptoProvider :: ForeignPtr FFI.CryptoProvider
  }

instance Show CryptoProvider where
  show :: CryptoProvider -> String
show CryptoProvider
_ = String
"CryptoProvider"

-- | An ALPN protocol ID. See
-- <https://www.iana.org/assignments/tls-extensiontype-values/tls-extensiontype-values.xhtml#alpn-protocol-ids>
-- for a list of registered IDs.
newtype ALPNProtocol = ALPNProtocol {ALPNProtocol -> ByteString
unALPNProtocol :: ByteString}
  deriving stock (Int -> ALPNProtocol -> ShowS
[ALPNProtocol] -> ShowS
ALPNProtocol -> String
(Int -> ALPNProtocol -> ShowS)
-> (ALPNProtocol -> String)
-> ([ALPNProtocol] -> ShowS)
-> Show ALPNProtocol
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ALPNProtocol -> ShowS
showsPrec :: Int -> ALPNProtocol -> ShowS
$cshow :: ALPNProtocol -> String
show :: ALPNProtocol -> String
$cshowList :: [ALPNProtocol] -> ShowS
showList :: [ALPNProtocol] -> ShowS
Show, ALPNProtocol -> ALPNProtocol -> Bool
(ALPNProtocol -> ALPNProtocol -> Bool)
-> (ALPNProtocol -> ALPNProtocol -> Bool) -> Eq ALPNProtocol
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ALPNProtocol -> ALPNProtocol -> Bool
== :: ALPNProtocol -> ALPNProtocol -> Bool
$c/= :: ALPNProtocol -> ALPNProtocol -> Bool
/= :: ALPNProtocol -> ALPNProtocol -> Bool
Eq, Eq ALPNProtocol
Eq ALPNProtocol =>
(ALPNProtocol -> ALPNProtocol -> Ordering)
-> (ALPNProtocol -> ALPNProtocol -> Bool)
-> (ALPNProtocol -> ALPNProtocol -> Bool)
-> (ALPNProtocol -> ALPNProtocol -> Bool)
-> (ALPNProtocol -> ALPNProtocol -> Bool)
-> (ALPNProtocol -> ALPNProtocol -> ALPNProtocol)
-> (ALPNProtocol -> ALPNProtocol -> ALPNProtocol)
-> Ord ALPNProtocol
ALPNProtocol -> ALPNProtocol -> Bool
ALPNProtocol -> ALPNProtocol -> Ordering
ALPNProtocol -> ALPNProtocol -> ALPNProtocol
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 :: ALPNProtocol -> ALPNProtocol -> Ordering
compare :: ALPNProtocol -> ALPNProtocol -> Ordering
$c< :: ALPNProtocol -> ALPNProtocol -> Bool
< :: ALPNProtocol -> ALPNProtocol -> Bool
$c<= :: ALPNProtocol -> ALPNProtocol -> Bool
<= :: ALPNProtocol -> ALPNProtocol -> Bool
$c> :: ALPNProtocol -> ALPNProtocol -> Bool
> :: ALPNProtocol -> ALPNProtocol -> Bool
$c>= :: ALPNProtocol -> ALPNProtocol -> Bool
>= :: ALPNProtocol -> ALPNProtocol -> Bool
$cmax :: ALPNProtocol -> ALPNProtocol -> ALPNProtocol
max :: ALPNProtocol -> ALPNProtocol -> ALPNProtocol
$cmin :: ALPNProtocol -> ALPNProtocol -> ALPNProtocol
min :: ALPNProtocol -> ALPNProtocol -> ALPNProtocol
Ord, (forall x. ALPNProtocol -> Rep ALPNProtocol x)
-> (forall x. Rep ALPNProtocol x -> ALPNProtocol)
-> Generic ALPNProtocol
forall x. Rep ALPNProtocol x -> ALPNProtocol
forall x. ALPNProtocol -> Rep ALPNProtocol x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ALPNProtocol -> Rep ALPNProtocol x
from :: forall x. ALPNProtocol -> Rep ALPNProtocol x
$cto :: forall x. Rep ALPNProtocol x -> ALPNProtocol
to :: forall x. Rep ALPNProtocol x -> ALPNProtocol
Generic)

-- | A TLS cipher suite supported by a Rustls cryptography provider.
data CipherSuite = CipherSuite
  { -- | The IANA value of the cipher suite. The bytes are interpreted in
    -- network order.
    --
    -- See
    -- <https://www.iana.org/assignments/tls-parameters/tls-parameters.xhtml#tls-parameters-4>
    -- for a list.
    CipherSuite -> Word16
cipherSuiteID :: Word16,
    -- | The text representation of the cipher suite.
    CipherSuite -> Text
cipherSuiteName :: Text,
    -- | The TLS version of the cipher suite.
    CipherSuite -> TLSVersion
cipherSuiteTLSVersion :: FFI.TLSVersion
  }
  deriving stock (Int -> CipherSuite -> ShowS
[CipherSuite] -> ShowS
CipherSuite -> String
(Int -> CipherSuite -> ShowS)
-> (CipherSuite -> String)
-> ([CipherSuite] -> ShowS)
-> Show CipherSuite
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CipherSuite -> ShowS
showsPrec :: Int -> CipherSuite -> ShowS
$cshow :: CipherSuite -> String
show :: CipherSuite -> String
$cshowList :: [CipherSuite] -> ShowS
showList :: [CipherSuite] -> ShowS
Show, CipherSuite -> CipherSuite -> Bool
(CipherSuite -> CipherSuite -> Bool)
-> (CipherSuite -> CipherSuite -> Bool) -> Eq CipherSuite
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CipherSuite -> CipherSuite -> Bool
== :: CipherSuite -> CipherSuite -> Bool
$c/= :: CipherSuite -> CipherSuite -> Bool
/= :: CipherSuite -> CipherSuite -> Bool
Eq, Eq CipherSuite
Eq CipherSuite =>
(CipherSuite -> CipherSuite -> Ordering)
-> (CipherSuite -> CipherSuite -> Bool)
-> (CipherSuite -> CipherSuite -> Bool)
-> (CipherSuite -> CipherSuite -> Bool)
-> (CipherSuite -> CipherSuite -> Bool)
-> (CipherSuite -> CipherSuite -> CipherSuite)
-> (CipherSuite -> CipherSuite -> CipherSuite)
-> Ord CipherSuite
CipherSuite -> CipherSuite -> Bool
CipherSuite -> CipherSuite -> Ordering
CipherSuite -> CipherSuite -> CipherSuite
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 :: CipherSuite -> CipherSuite -> Ordering
compare :: CipherSuite -> CipherSuite -> Ordering
$c< :: CipherSuite -> CipherSuite -> Bool
< :: CipherSuite -> CipherSuite -> Bool
$c<= :: CipherSuite -> CipherSuite -> Bool
<= :: CipherSuite -> CipherSuite -> Bool
$c> :: CipherSuite -> CipherSuite -> Bool
> :: CipherSuite -> CipherSuite -> Bool
$c>= :: CipherSuite -> CipherSuite -> Bool
>= :: CipherSuite -> CipherSuite -> Bool
$cmax :: CipherSuite -> CipherSuite -> CipherSuite
max :: CipherSuite -> CipherSuite -> CipherSuite
$cmin :: CipherSuite -> CipherSuite -> CipherSuite
min :: CipherSuite -> CipherSuite -> CipherSuite
Ord, (forall x. CipherSuite -> Rep CipherSuite x)
-> (forall x. Rep CipherSuite x -> CipherSuite)
-> Generic CipherSuite
forall x. Rep CipherSuite x -> CipherSuite
forall x. CipherSuite -> Rep CipherSuite x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CipherSuite -> Rep CipherSuite x
from :: forall x. CipherSuite -> Rep CipherSuite x
$cto :: forall x. Rep CipherSuite x -> CipherSuite
to :: forall x. Rep CipherSuite x -> CipherSuite
Generic)

-- | A negotiated TLS cipher suite. Subset of 'CipherSuite'.
data NegotiatedCipherSuite = NegotiatedCipherSuite
  { -- | The IANA value of the cipher suite. The bytes are interpreted in
    -- network order.
    --
    -- See
    -- <https://www.iana.org/assignments/tls-parameters/tls-parameters.xhtml#tls-parameters-4>
    -- for a list.
    NegotiatedCipherSuite -> Word16
negotiatedCipherSuiteID :: Word16,
    -- | The text representation of the cipher suite.
    NegotiatedCipherSuite -> Text
negotiatedCipherSuiteName :: Text
  }
  deriving stock (Int -> NegotiatedCipherSuite -> ShowS
[NegotiatedCipherSuite] -> ShowS
NegotiatedCipherSuite -> String
(Int -> NegotiatedCipherSuite -> ShowS)
-> (NegotiatedCipherSuite -> String)
-> ([NegotiatedCipherSuite] -> ShowS)
-> Show NegotiatedCipherSuite
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NegotiatedCipherSuite -> ShowS
showsPrec :: Int -> NegotiatedCipherSuite -> ShowS
$cshow :: NegotiatedCipherSuite -> String
show :: NegotiatedCipherSuite -> String
$cshowList :: [NegotiatedCipherSuite] -> ShowS
showList :: [NegotiatedCipherSuite] -> ShowS
Show, NegotiatedCipherSuite -> NegotiatedCipherSuite -> Bool
(NegotiatedCipherSuite -> NegotiatedCipherSuite -> Bool)
-> (NegotiatedCipherSuite -> NegotiatedCipherSuite -> Bool)
-> Eq NegotiatedCipherSuite
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NegotiatedCipherSuite -> NegotiatedCipherSuite -> Bool
== :: NegotiatedCipherSuite -> NegotiatedCipherSuite -> Bool
$c/= :: NegotiatedCipherSuite -> NegotiatedCipherSuite -> Bool
/= :: NegotiatedCipherSuite -> NegotiatedCipherSuite -> Bool
Eq, Eq NegotiatedCipherSuite
Eq NegotiatedCipherSuite =>
(NegotiatedCipherSuite -> NegotiatedCipherSuite -> Ordering)
-> (NegotiatedCipherSuite -> NegotiatedCipherSuite -> Bool)
-> (NegotiatedCipherSuite -> NegotiatedCipherSuite -> Bool)
-> (NegotiatedCipherSuite -> NegotiatedCipherSuite -> Bool)
-> (NegotiatedCipherSuite -> NegotiatedCipherSuite -> Bool)
-> (NegotiatedCipherSuite
    -> NegotiatedCipherSuite -> NegotiatedCipherSuite)
-> (NegotiatedCipherSuite
    -> NegotiatedCipherSuite -> NegotiatedCipherSuite)
-> Ord NegotiatedCipherSuite
NegotiatedCipherSuite -> NegotiatedCipherSuite -> Bool
NegotiatedCipherSuite -> NegotiatedCipherSuite -> Ordering
NegotiatedCipherSuite
-> NegotiatedCipherSuite -> NegotiatedCipherSuite
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 :: NegotiatedCipherSuite -> NegotiatedCipherSuite -> Ordering
compare :: NegotiatedCipherSuite -> NegotiatedCipherSuite -> Ordering
$c< :: NegotiatedCipherSuite -> NegotiatedCipherSuite -> Bool
< :: NegotiatedCipherSuite -> NegotiatedCipherSuite -> Bool
$c<= :: NegotiatedCipherSuite -> NegotiatedCipherSuite -> Bool
<= :: NegotiatedCipherSuite -> NegotiatedCipherSuite -> Bool
$c> :: NegotiatedCipherSuite -> NegotiatedCipherSuite -> Bool
> :: NegotiatedCipherSuite -> NegotiatedCipherSuite -> Bool
$c>= :: NegotiatedCipherSuite -> NegotiatedCipherSuite -> Bool
>= :: NegotiatedCipherSuite -> NegotiatedCipherSuite -> Bool
$cmax :: NegotiatedCipherSuite
-> NegotiatedCipherSuite -> NegotiatedCipherSuite
max :: NegotiatedCipherSuite
-> NegotiatedCipherSuite -> NegotiatedCipherSuite
$cmin :: NegotiatedCipherSuite
-> NegotiatedCipherSuite -> NegotiatedCipherSuite
min :: NegotiatedCipherSuite
-> NegotiatedCipherSuite -> NegotiatedCipherSuite
Ord, (forall x. NegotiatedCipherSuite -> Rep NegotiatedCipherSuite x)
-> (forall x. Rep NegotiatedCipherSuite x -> NegotiatedCipherSuite)
-> Generic NegotiatedCipherSuite
forall x. Rep NegotiatedCipherSuite x -> NegotiatedCipherSuite
forall x. NegotiatedCipherSuite -> Rep NegotiatedCipherSuite x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NegotiatedCipherSuite -> Rep NegotiatedCipherSuite x
from :: forall x. NegotiatedCipherSuite -> Rep NegotiatedCipherSuite x
$cto :: forall x. Rep NegotiatedCipherSuite x -> NegotiatedCipherSuite
to :: forall x. Rep NegotiatedCipherSuite x -> NegotiatedCipherSuite
Generic)

-- | Rustls client config builder.
data ClientConfigBuilder = ClientConfigBuilder
  { -- | The cryptography provider.
    ClientConfigBuilder -> CryptoProvider
clientConfigCryptoProvider :: CryptoProvider,
    -- | The server certificate verifier.
    ClientConfigBuilder -> ServerCertVerifier
clientConfigServerCertVerifier :: ServerCertVerifier,
    -- | ALPN protocols.
    ClientConfigBuilder -> [ALPNProtocol]
clientConfigALPNProtocols :: [ALPNProtocol],
    -- | Whether to enable Server Name Indication. Defaults to 'True'.
    ClientConfigBuilder -> Bool
clientConfigEnableSNI :: Bool,
    -- | List of 'CertifiedKey's for client authentication.
    --
    -- Clients that want to support both ECDSA and RSA certificates will want
    -- the ECDSA to go first in the list.
    ClientConfigBuilder -> [CertifiedKey]
clientConfigCertifiedKeys :: [CertifiedKey]
  }
  deriving stock (Int -> ClientConfigBuilder -> ShowS
[ClientConfigBuilder] -> ShowS
ClientConfigBuilder -> String
(Int -> ClientConfigBuilder -> ShowS)
-> (ClientConfigBuilder -> String)
-> ([ClientConfigBuilder] -> ShowS)
-> Show ClientConfigBuilder
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClientConfigBuilder -> ShowS
showsPrec :: Int -> ClientConfigBuilder -> ShowS
$cshow :: ClientConfigBuilder -> String
show :: ClientConfigBuilder -> String
$cshowList :: [ClientConfigBuilder] -> ShowS
showList :: [ClientConfigBuilder] -> ShowS
Show, (forall x. ClientConfigBuilder -> Rep ClientConfigBuilder x)
-> (forall x. Rep ClientConfigBuilder x -> ClientConfigBuilder)
-> Generic ClientConfigBuilder
forall x. Rep ClientConfigBuilder x -> ClientConfigBuilder
forall x. ClientConfigBuilder -> Rep ClientConfigBuilder x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ClientConfigBuilder -> Rep ClientConfigBuilder x
from :: forall x. ClientConfigBuilder -> Rep ClientConfigBuilder x
$cto :: forall x. Rep ClientConfigBuilder x -> ClientConfigBuilder
to :: forall x. Rep ClientConfigBuilder x -> ClientConfigBuilder
Generic)

-- | How to verify TLS server certificates.
data ServerCertVerifier
  = -- | Verify the validity of TLS certificates based on the operating system's
    -- certificate facilities, using
    -- [rustls-platform-verifier](https://github.com/rustls/rustls-platform-verifier).
    PlatformServerCertVerifier
  | ServerCertVerifier
      { -- | Certificates used to verify TLS server certificates.
        ServerCertVerifier -> NonEmpty PEMCertificates
serverCertVerifierCertificates :: NonEmpty PEMCertificates,
        -- | List of certificate revocation lists used to verify TLS server
        -- certificates.
        ServerCertVerifier -> [CertificateRevocationList]
serverCertVerifierCRLs :: [CertificateRevocationList]
      }
  deriving stock (Int -> ServerCertVerifier -> ShowS
[ServerCertVerifier] -> ShowS
ServerCertVerifier -> String
(Int -> ServerCertVerifier -> ShowS)
-> (ServerCertVerifier -> String)
-> ([ServerCertVerifier] -> ShowS)
-> Show ServerCertVerifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ServerCertVerifier -> ShowS
showsPrec :: Int -> ServerCertVerifier -> ShowS
$cshow :: ServerCertVerifier -> String
show :: ServerCertVerifier -> String
$cshowList :: [ServerCertVerifier] -> ShowS
showList :: [ServerCertVerifier] -> ShowS
Show, (forall x. ServerCertVerifier -> Rep ServerCertVerifier x)
-> (forall x. Rep ServerCertVerifier x -> ServerCertVerifier)
-> Generic ServerCertVerifier
forall x. Rep ServerCertVerifier x -> ServerCertVerifier
forall x. ServerCertVerifier -> Rep ServerCertVerifier x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ServerCertVerifier -> Rep ServerCertVerifier x
from :: forall x. ServerCertVerifier -> Rep ServerCertVerifier x
$cto :: forall x. Rep ServerCertVerifier x -> ServerCertVerifier
to :: forall x. Rep ServerCertVerifier x -> ServerCertVerifier
Generic)

-- | A source of PEM-encoded certificates.
data PEMCertificates
  = -- | In-memory PEM-encoded certificates.
    PEMCertificatesInMemory ByteString PEMCertificateParsing
  | -- |  Fetch PEM-encoded root certificates from a file.
    PemCertificatesFromFile FilePath PEMCertificateParsing
  deriving stock (Int -> PEMCertificates -> ShowS
[PEMCertificates] -> ShowS
PEMCertificates -> String
(Int -> PEMCertificates -> ShowS)
-> (PEMCertificates -> String)
-> ([PEMCertificates] -> ShowS)
-> Show PEMCertificates
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PEMCertificates -> ShowS
showsPrec :: Int -> PEMCertificates -> ShowS
$cshow :: PEMCertificates -> String
show :: PEMCertificates -> String
$cshowList :: [PEMCertificates] -> ShowS
showList :: [PEMCertificates] -> ShowS
Show, (forall x. PEMCertificates -> Rep PEMCertificates x)
-> (forall x. Rep PEMCertificates x -> PEMCertificates)
-> Generic PEMCertificates
forall x. Rep PEMCertificates x -> PEMCertificates
forall x. PEMCertificates -> Rep PEMCertificates x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PEMCertificates -> Rep PEMCertificates x
from :: forall x. PEMCertificates -> Rep PEMCertificates x
$cto :: forall x. Rep PEMCertificates x -> PEMCertificates
to :: forall x. Rep PEMCertificates x -> PEMCertificates
Generic)

-- | Parsing mode for PEM-encoded certificates.
data PEMCertificateParsing
  = -- | Fail if syntactically invalid.
    PEMCertificateParsingStrict
  | -- | Ignore if syntactically invalid.
    --
    -- This may be useful on systems that have syntactically invalid root
    -- certificates.
    PEMCertificateParsingLax
  deriving stock (Int -> PEMCertificateParsing -> ShowS
[PEMCertificateParsing] -> ShowS
PEMCertificateParsing -> String
(Int -> PEMCertificateParsing -> ShowS)
-> (PEMCertificateParsing -> String)
-> ([PEMCertificateParsing] -> ShowS)
-> Show PEMCertificateParsing
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PEMCertificateParsing -> ShowS
showsPrec :: Int -> PEMCertificateParsing -> ShowS
$cshow :: PEMCertificateParsing -> String
show :: PEMCertificateParsing -> String
$cshowList :: [PEMCertificateParsing] -> ShowS
showList :: [PEMCertificateParsing] -> ShowS
Show, PEMCertificateParsing -> PEMCertificateParsing -> Bool
(PEMCertificateParsing -> PEMCertificateParsing -> Bool)
-> (PEMCertificateParsing -> PEMCertificateParsing -> Bool)
-> Eq PEMCertificateParsing
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PEMCertificateParsing -> PEMCertificateParsing -> Bool
== :: PEMCertificateParsing -> PEMCertificateParsing -> Bool
$c/= :: PEMCertificateParsing -> PEMCertificateParsing -> Bool
/= :: PEMCertificateParsing -> PEMCertificateParsing -> Bool
Eq, Eq PEMCertificateParsing
Eq PEMCertificateParsing =>
(PEMCertificateParsing -> PEMCertificateParsing -> Ordering)
-> (PEMCertificateParsing -> PEMCertificateParsing -> Bool)
-> (PEMCertificateParsing -> PEMCertificateParsing -> Bool)
-> (PEMCertificateParsing -> PEMCertificateParsing -> Bool)
-> (PEMCertificateParsing -> PEMCertificateParsing -> Bool)
-> (PEMCertificateParsing
    -> PEMCertificateParsing -> PEMCertificateParsing)
-> (PEMCertificateParsing
    -> PEMCertificateParsing -> PEMCertificateParsing)
-> Ord PEMCertificateParsing
PEMCertificateParsing -> PEMCertificateParsing -> Bool
PEMCertificateParsing -> PEMCertificateParsing -> Ordering
PEMCertificateParsing
-> PEMCertificateParsing -> PEMCertificateParsing
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 :: PEMCertificateParsing -> PEMCertificateParsing -> Ordering
compare :: PEMCertificateParsing -> PEMCertificateParsing -> Ordering
$c< :: PEMCertificateParsing -> PEMCertificateParsing -> Bool
< :: PEMCertificateParsing -> PEMCertificateParsing -> Bool
$c<= :: PEMCertificateParsing -> PEMCertificateParsing -> Bool
<= :: PEMCertificateParsing -> PEMCertificateParsing -> Bool
$c> :: PEMCertificateParsing -> PEMCertificateParsing -> Bool
> :: PEMCertificateParsing -> PEMCertificateParsing -> Bool
$c>= :: PEMCertificateParsing -> PEMCertificateParsing -> Bool
>= :: PEMCertificateParsing -> PEMCertificateParsing -> Bool
$cmax :: PEMCertificateParsing
-> PEMCertificateParsing -> PEMCertificateParsing
max :: PEMCertificateParsing
-> PEMCertificateParsing -> PEMCertificateParsing
$cmin :: PEMCertificateParsing
-> PEMCertificateParsing -> PEMCertificateParsing
min :: PEMCertificateParsing
-> PEMCertificateParsing -> PEMCertificateParsing
Ord, Int -> PEMCertificateParsing
PEMCertificateParsing -> Int
PEMCertificateParsing -> [PEMCertificateParsing]
PEMCertificateParsing -> PEMCertificateParsing
PEMCertificateParsing
-> PEMCertificateParsing -> [PEMCertificateParsing]
PEMCertificateParsing
-> PEMCertificateParsing
-> PEMCertificateParsing
-> [PEMCertificateParsing]
(PEMCertificateParsing -> PEMCertificateParsing)
-> (PEMCertificateParsing -> PEMCertificateParsing)
-> (Int -> PEMCertificateParsing)
-> (PEMCertificateParsing -> Int)
-> (PEMCertificateParsing -> [PEMCertificateParsing])
-> (PEMCertificateParsing
    -> PEMCertificateParsing -> [PEMCertificateParsing])
-> (PEMCertificateParsing
    -> PEMCertificateParsing -> [PEMCertificateParsing])
-> (PEMCertificateParsing
    -> PEMCertificateParsing
    -> PEMCertificateParsing
    -> [PEMCertificateParsing])
-> Enum PEMCertificateParsing
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: PEMCertificateParsing -> PEMCertificateParsing
succ :: PEMCertificateParsing -> PEMCertificateParsing
$cpred :: PEMCertificateParsing -> PEMCertificateParsing
pred :: PEMCertificateParsing -> PEMCertificateParsing
$ctoEnum :: Int -> PEMCertificateParsing
toEnum :: Int -> PEMCertificateParsing
$cfromEnum :: PEMCertificateParsing -> Int
fromEnum :: PEMCertificateParsing -> Int
$cenumFrom :: PEMCertificateParsing -> [PEMCertificateParsing]
enumFrom :: PEMCertificateParsing -> [PEMCertificateParsing]
$cenumFromThen :: PEMCertificateParsing
-> PEMCertificateParsing -> [PEMCertificateParsing]
enumFromThen :: PEMCertificateParsing
-> PEMCertificateParsing -> [PEMCertificateParsing]
$cenumFromTo :: PEMCertificateParsing
-> PEMCertificateParsing -> [PEMCertificateParsing]
enumFromTo :: PEMCertificateParsing
-> PEMCertificateParsing -> [PEMCertificateParsing]
$cenumFromThenTo :: PEMCertificateParsing
-> PEMCertificateParsing
-> PEMCertificateParsing
-> [PEMCertificateParsing]
enumFromThenTo :: PEMCertificateParsing
-> PEMCertificateParsing
-> PEMCertificateParsing
-> [PEMCertificateParsing]
Enum, PEMCertificateParsing
PEMCertificateParsing
-> PEMCertificateParsing -> Bounded PEMCertificateParsing
forall a. a -> a -> Bounded a
$cminBound :: PEMCertificateParsing
minBound :: PEMCertificateParsing
$cmaxBound :: PEMCertificateParsing
maxBound :: PEMCertificateParsing
Bounded, (forall x. PEMCertificateParsing -> Rep PEMCertificateParsing x)
-> (forall x. Rep PEMCertificateParsing x -> PEMCertificateParsing)
-> Generic PEMCertificateParsing
forall x. Rep PEMCertificateParsing x -> PEMCertificateParsing
forall x. PEMCertificateParsing -> Rep PEMCertificateParsing x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PEMCertificateParsing -> Rep PEMCertificateParsing x
from :: forall x. PEMCertificateParsing -> Rep PEMCertificateParsing x
$cto :: forall x. Rep PEMCertificateParsing x -> PEMCertificateParsing
to :: forall x. Rep PEMCertificateParsing x -> PEMCertificateParsing
Generic)

-- | A complete chain of certificates plus a private key for the leaf certificate.
data CertifiedKey = CertifiedKey
  { -- | PEM-encoded certificate chain.
    CertifiedKey -> ByteString
certificateChain :: ByteString,
    -- | PEM-encoded private key.
    CertifiedKey -> ByteString
privateKey :: ByteString
  }
  deriving stock ((forall x. CertifiedKey -> Rep CertifiedKey x)
-> (forall x. Rep CertifiedKey x -> CertifiedKey)
-> Generic CertifiedKey
forall x. Rep CertifiedKey x -> CertifiedKey
forall x. CertifiedKey -> Rep CertifiedKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CertifiedKey -> Rep CertifiedKey x
from :: forall x. CertifiedKey -> Rep CertifiedKey x
$cto :: forall x. Rep CertifiedKey x -> CertifiedKey
to :: forall x. Rep CertifiedKey x -> CertifiedKey
Generic)

instance Show CertifiedKey where
  show :: CertifiedKey -> String
show CertifiedKey
_ = String
"CertifiedKey"

-- | Assembled configuration for a Rustls client connection.
data ClientConfig = ClientConfig
  { ClientConfig -> ForeignPtr ClientConfig
clientConfigPtr :: ForeignPtr FFI.ClientConfig,
    -- | A logging callback.
    --
    -- Note that this is a record selector, so you can use it as a setter:
    --
    -- >>> :{
    -- setLogCallback :: LogCallback -> ClientConfig -> ClientConfig
    -- setLogCallback logCallback clientConfig =
    --   clientConfig { clientConfigLogCallback = Just logCallback }
    -- :}
    ClientConfig -> Maybe LogCallback
clientConfigLogCallback :: Maybe LogCallback
  }

-- | How to verify TLS client certificates.
data ClientCertVerifier = ClientCertVerifier
  { -- | Which client connections are allowed.
    ClientCertVerifier -> ClientCertVerifierPolicy
clientCertVerifierPolicy :: ClientCertVerifierPolicy,
    -- | Certificates used to verify TLS client certificates.
    ClientCertVerifier -> NonEmpty PEMCertificates
clientCertVerifierCertificates :: NonEmpty PEMCertificates,
    -- | List of certificate revocation lists used to verify TLS client
    -- certificates.
    ClientCertVerifier -> [CertificateRevocationList]
clientCertVerifierCRLs :: [CertificateRevocationList]
  }
  deriving stock (Int -> ClientCertVerifier -> ShowS
[ClientCertVerifier] -> ShowS
ClientCertVerifier -> String
(Int -> ClientCertVerifier -> ShowS)
-> (ClientCertVerifier -> String)
-> ([ClientCertVerifier] -> ShowS)
-> Show ClientCertVerifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClientCertVerifier -> ShowS
showsPrec :: Int -> ClientCertVerifier -> ShowS
$cshow :: ClientCertVerifier -> String
show :: ClientCertVerifier -> String
$cshowList :: [ClientCertVerifier] -> ShowS
showList :: [ClientCertVerifier] -> ShowS
Show, (forall x. ClientCertVerifier -> Rep ClientCertVerifier x)
-> (forall x. Rep ClientCertVerifier x -> ClientCertVerifier)
-> Generic ClientCertVerifier
forall x. Rep ClientCertVerifier x -> ClientCertVerifier
forall x. ClientCertVerifier -> Rep ClientCertVerifier x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ClientCertVerifier -> Rep ClientCertVerifier x
from :: forall x. ClientCertVerifier -> Rep ClientCertVerifier x
$cto :: forall x. Rep ClientCertVerifier x -> ClientCertVerifier
to :: forall x. Rep ClientCertVerifier x -> ClientCertVerifier
Generic)

-- | Which client connections are allowed by a 'ClientCertVerifier'.
data ClientCertVerifierPolicy
  = -- | Allow any authenticated client (i.e. offering a trusted certificate),
    -- and reject clients offering none.
    AllowAnyAuthenticatedClient
  | -- | Allow any authenticated client (i.e. offering a trusted certificate),
    -- but also allow clients offering none.
    AllowAnyAnonymousOrAuthenticatedClient
  deriving stock (Int -> ClientCertVerifierPolicy -> ShowS
[ClientCertVerifierPolicy] -> ShowS
ClientCertVerifierPolicy -> String
(Int -> ClientCertVerifierPolicy -> ShowS)
-> (ClientCertVerifierPolicy -> String)
-> ([ClientCertVerifierPolicy] -> ShowS)
-> Show ClientCertVerifierPolicy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClientCertVerifierPolicy -> ShowS
showsPrec :: Int -> ClientCertVerifierPolicy -> ShowS
$cshow :: ClientCertVerifierPolicy -> String
show :: ClientCertVerifierPolicy -> String
$cshowList :: [ClientCertVerifierPolicy] -> ShowS
showList :: [ClientCertVerifierPolicy] -> ShowS
Show, ClientCertVerifierPolicy -> ClientCertVerifierPolicy -> Bool
(ClientCertVerifierPolicy -> ClientCertVerifierPolicy -> Bool)
-> (ClientCertVerifierPolicy -> ClientCertVerifierPolicy -> Bool)
-> Eq ClientCertVerifierPolicy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ClientCertVerifierPolicy -> ClientCertVerifierPolicy -> Bool
== :: ClientCertVerifierPolicy -> ClientCertVerifierPolicy -> Bool
$c/= :: ClientCertVerifierPolicy -> ClientCertVerifierPolicy -> Bool
/= :: ClientCertVerifierPolicy -> ClientCertVerifierPolicy -> Bool
Eq, Eq ClientCertVerifierPolicy
Eq ClientCertVerifierPolicy =>
(ClientCertVerifierPolicy -> ClientCertVerifierPolicy -> Ordering)
-> (ClientCertVerifierPolicy -> ClientCertVerifierPolicy -> Bool)
-> (ClientCertVerifierPolicy -> ClientCertVerifierPolicy -> Bool)
-> (ClientCertVerifierPolicy -> ClientCertVerifierPolicy -> Bool)
-> (ClientCertVerifierPolicy -> ClientCertVerifierPolicy -> Bool)
-> (ClientCertVerifierPolicy
    -> ClientCertVerifierPolicy -> ClientCertVerifierPolicy)
-> (ClientCertVerifierPolicy
    -> ClientCertVerifierPolicy -> ClientCertVerifierPolicy)
-> Ord ClientCertVerifierPolicy
ClientCertVerifierPolicy -> ClientCertVerifierPolicy -> Bool
ClientCertVerifierPolicy -> ClientCertVerifierPolicy -> Ordering
ClientCertVerifierPolicy
-> ClientCertVerifierPolicy -> ClientCertVerifierPolicy
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 :: ClientCertVerifierPolicy -> ClientCertVerifierPolicy -> Ordering
compare :: ClientCertVerifierPolicy -> ClientCertVerifierPolicy -> Ordering
$c< :: ClientCertVerifierPolicy -> ClientCertVerifierPolicy -> Bool
< :: ClientCertVerifierPolicy -> ClientCertVerifierPolicy -> Bool
$c<= :: ClientCertVerifierPolicy -> ClientCertVerifierPolicy -> Bool
<= :: ClientCertVerifierPolicy -> ClientCertVerifierPolicy -> Bool
$c> :: ClientCertVerifierPolicy -> ClientCertVerifierPolicy -> Bool
> :: ClientCertVerifierPolicy -> ClientCertVerifierPolicy -> Bool
$c>= :: ClientCertVerifierPolicy -> ClientCertVerifierPolicy -> Bool
>= :: ClientCertVerifierPolicy -> ClientCertVerifierPolicy -> Bool
$cmax :: ClientCertVerifierPolicy
-> ClientCertVerifierPolicy -> ClientCertVerifierPolicy
max :: ClientCertVerifierPolicy
-> ClientCertVerifierPolicy -> ClientCertVerifierPolicy
$cmin :: ClientCertVerifierPolicy
-> ClientCertVerifierPolicy -> ClientCertVerifierPolicy
min :: ClientCertVerifierPolicy
-> ClientCertVerifierPolicy -> ClientCertVerifierPolicy
Ord, Int -> ClientCertVerifierPolicy
ClientCertVerifierPolicy -> Int
ClientCertVerifierPolicy -> [ClientCertVerifierPolicy]
ClientCertVerifierPolicy -> ClientCertVerifierPolicy
ClientCertVerifierPolicy
-> ClientCertVerifierPolicy -> [ClientCertVerifierPolicy]
ClientCertVerifierPolicy
-> ClientCertVerifierPolicy
-> ClientCertVerifierPolicy
-> [ClientCertVerifierPolicy]
(ClientCertVerifierPolicy -> ClientCertVerifierPolicy)
-> (ClientCertVerifierPolicy -> ClientCertVerifierPolicy)
-> (Int -> ClientCertVerifierPolicy)
-> (ClientCertVerifierPolicy -> Int)
-> (ClientCertVerifierPolicy -> [ClientCertVerifierPolicy])
-> (ClientCertVerifierPolicy
    -> ClientCertVerifierPolicy -> [ClientCertVerifierPolicy])
-> (ClientCertVerifierPolicy
    -> ClientCertVerifierPolicy -> [ClientCertVerifierPolicy])
-> (ClientCertVerifierPolicy
    -> ClientCertVerifierPolicy
    -> ClientCertVerifierPolicy
    -> [ClientCertVerifierPolicy])
-> Enum ClientCertVerifierPolicy
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ClientCertVerifierPolicy -> ClientCertVerifierPolicy
succ :: ClientCertVerifierPolicy -> ClientCertVerifierPolicy
$cpred :: ClientCertVerifierPolicy -> ClientCertVerifierPolicy
pred :: ClientCertVerifierPolicy -> ClientCertVerifierPolicy
$ctoEnum :: Int -> ClientCertVerifierPolicy
toEnum :: Int -> ClientCertVerifierPolicy
$cfromEnum :: ClientCertVerifierPolicy -> Int
fromEnum :: ClientCertVerifierPolicy -> Int
$cenumFrom :: ClientCertVerifierPolicy -> [ClientCertVerifierPolicy]
enumFrom :: ClientCertVerifierPolicy -> [ClientCertVerifierPolicy]
$cenumFromThen :: ClientCertVerifierPolicy
-> ClientCertVerifierPolicy -> [ClientCertVerifierPolicy]
enumFromThen :: ClientCertVerifierPolicy
-> ClientCertVerifierPolicy -> [ClientCertVerifierPolicy]
$cenumFromTo :: ClientCertVerifierPolicy
-> ClientCertVerifierPolicy -> [ClientCertVerifierPolicy]
enumFromTo :: ClientCertVerifierPolicy
-> ClientCertVerifierPolicy -> [ClientCertVerifierPolicy]
$cenumFromThenTo :: ClientCertVerifierPolicy
-> ClientCertVerifierPolicy
-> ClientCertVerifierPolicy
-> [ClientCertVerifierPolicy]
enumFromThenTo :: ClientCertVerifierPolicy
-> ClientCertVerifierPolicy
-> ClientCertVerifierPolicy
-> [ClientCertVerifierPolicy]
Enum, ClientCertVerifierPolicy
ClientCertVerifierPolicy
-> ClientCertVerifierPolicy -> Bounded ClientCertVerifierPolicy
forall a. a -> a -> Bounded a
$cminBound :: ClientCertVerifierPolicy
minBound :: ClientCertVerifierPolicy
$cmaxBound :: ClientCertVerifierPolicy
maxBound :: ClientCertVerifierPolicy
Bounded, (forall x.
 ClientCertVerifierPolicy -> Rep ClientCertVerifierPolicy x)
-> (forall x.
    Rep ClientCertVerifierPolicy x -> ClientCertVerifierPolicy)
-> Generic ClientCertVerifierPolicy
forall x.
Rep ClientCertVerifierPolicy x -> ClientCertVerifierPolicy
forall x.
ClientCertVerifierPolicy -> Rep ClientCertVerifierPolicy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ClientCertVerifierPolicy -> Rep ClientCertVerifierPolicy x
from :: forall x.
ClientCertVerifierPolicy -> Rep ClientCertVerifierPolicy x
$cto :: forall x.
Rep ClientCertVerifierPolicy x -> ClientCertVerifierPolicy
to :: forall x.
Rep ClientCertVerifierPolicy x -> ClientCertVerifierPolicy
Generic)

-- | One or more PEM-encoded certificate revocation lists (CRL).
newtype CertificateRevocationList = CertificateRevocationList
  { CertificateRevocationList -> ByteString
unCertificateRevocationList :: ByteString
  }
  deriving stock (Int -> CertificateRevocationList -> ShowS
[CertificateRevocationList] -> ShowS
CertificateRevocationList -> String
(Int -> CertificateRevocationList -> ShowS)
-> (CertificateRevocationList -> String)
-> ([CertificateRevocationList] -> ShowS)
-> Show CertificateRevocationList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CertificateRevocationList -> ShowS
showsPrec :: Int -> CertificateRevocationList -> ShowS
$cshow :: CertificateRevocationList -> String
show :: CertificateRevocationList -> String
$cshowList :: [CertificateRevocationList] -> ShowS
showList :: [CertificateRevocationList] -> ShowS
Show, (forall x.
 CertificateRevocationList -> Rep CertificateRevocationList x)
-> (forall x.
    Rep CertificateRevocationList x -> CertificateRevocationList)
-> Generic CertificateRevocationList
forall x.
Rep CertificateRevocationList x -> CertificateRevocationList
forall x.
CertificateRevocationList -> Rep CertificateRevocationList x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CertificateRevocationList -> Rep CertificateRevocationList x
from :: forall x.
CertificateRevocationList -> Rep CertificateRevocationList x
$cto :: forall x.
Rep CertificateRevocationList x -> CertificateRevocationList
to :: forall x.
Rep CertificateRevocationList x -> CertificateRevocationList
Generic)

-- | Rustls client config builder.
data ServerConfigBuilder = ServerConfigBuilder
  { -- | The cryptography provider.
    ServerConfigBuilder -> CryptoProvider
serverConfigCryptoProvider :: CryptoProvider,
    -- | List of 'CertifiedKey's.
    ServerConfigBuilder -> NonEmpty CertifiedKey
serverConfigCertifiedKeys :: NonEmpty CertifiedKey,
    -- | ALPN protocols.
    ServerConfigBuilder -> [ALPNProtocol]
serverConfigALPNProtocols :: [ALPNProtocol],
    -- | Ignore the client's ciphersuite order. Defaults to 'False'.
    ServerConfigBuilder -> Bool
serverConfigIgnoreClientOrder :: Bool,
    -- | Optionally, a client cert verifier.
    ServerConfigBuilder -> Maybe ClientCertVerifier
serverConfigClientCertVerifier :: Maybe ClientCertVerifier
  }
  deriving stock (Int -> ServerConfigBuilder -> ShowS
[ServerConfigBuilder] -> ShowS
ServerConfigBuilder -> String
(Int -> ServerConfigBuilder -> ShowS)
-> (ServerConfigBuilder -> String)
-> ([ServerConfigBuilder] -> ShowS)
-> Show ServerConfigBuilder
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ServerConfigBuilder -> ShowS
showsPrec :: Int -> ServerConfigBuilder -> ShowS
$cshow :: ServerConfigBuilder -> String
show :: ServerConfigBuilder -> String
$cshowList :: [ServerConfigBuilder] -> ShowS
showList :: [ServerConfigBuilder] -> ShowS
Show, (forall x. ServerConfigBuilder -> Rep ServerConfigBuilder x)
-> (forall x. Rep ServerConfigBuilder x -> ServerConfigBuilder)
-> Generic ServerConfigBuilder
forall x. Rep ServerConfigBuilder x -> ServerConfigBuilder
forall x. ServerConfigBuilder -> Rep ServerConfigBuilder x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ServerConfigBuilder -> Rep ServerConfigBuilder x
from :: forall x. ServerConfigBuilder -> Rep ServerConfigBuilder x
$cto :: forall x. Rep ServerConfigBuilder x -> ServerConfigBuilder
to :: forall x. Rep ServerConfigBuilder x -> ServerConfigBuilder
Generic)

-- | Assembled configuration for a Rustls server connection.
data ServerConfig = ServerConfig
  { ServerConfig -> ForeignPtr ServerConfig
serverConfigPtr :: ForeignPtr FFI.ServerConfig,
    -- | A logging callback.
    --
    -- Note that this is a record selector, so you can use it as a setter:
    --
    -- >>> :{
    -- setLogCallback :: LogCallback -> ServerConfig -> ServerConfig
    -- setLogCallback logCallback serverConfig =
    --   serverConfig { serverConfigLogCallback = Just logCallback }
    -- :}
    ServerConfig -> Maybe LogCallback
serverConfigLogCallback :: Maybe LogCallback
  }

-- | Rustls log level.
data LogLevel
  = LogLevelError
  | LogLevelWarn
  | LogLevelInfo
  | LogLevelDebug
  | LogLevelTrace
  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, Eq LogLevel
Eq LogLevel =>
(LogLevel -> LogLevel -> Ordering)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> LogLevel)
-> (LogLevel -> LogLevel -> LogLevel)
-> Ord LogLevel
LogLevel -> LogLevel -> Bool
LogLevel -> LogLevel -> Ordering
LogLevel -> LogLevel -> LogLevel
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 :: LogLevel -> LogLevel -> Ordering
compare :: LogLevel -> LogLevel -> Ordering
$c< :: LogLevel -> LogLevel -> Bool
< :: LogLevel -> LogLevel -> Bool
$c<= :: LogLevel -> LogLevel -> Bool
<= :: LogLevel -> LogLevel -> Bool
$c> :: LogLevel -> LogLevel -> Bool
> :: LogLevel -> LogLevel -> Bool
$c>= :: LogLevel -> LogLevel -> Bool
>= :: LogLevel -> LogLevel -> Bool
$cmax :: LogLevel -> LogLevel -> LogLevel
max :: LogLevel -> LogLevel -> LogLevel
$cmin :: LogLevel -> LogLevel -> LogLevel
min :: LogLevel -> LogLevel -> LogLevel
Ord, Int -> LogLevel
LogLevel -> Int
LogLevel -> [LogLevel]
LogLevel -> LogLevel
LogLevel -> LogLevel -> [LogLevel]
LogLevel -> LogLevel -> LogLevel -> [LogLevel]
(LogLevel -> LogLevel)
-> (LogLevel -> LogLevel)
-> (Int -> LogLevel)
-> (LogLevel -> Int)
-> (LogLevel -> [LogLevel])
-> (LogLevel -> LogLevel -> [LogLevel])
-> (LogLevel -> LogLevel -> [LogLevel])
-> (LogLevel -> LogLevel -> LogLevel -> [LogLevel])
-> Enum LogLevel
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: LogLevel -> LogLevel
succ :: LogLevel -> LogLevel
$cpred :: LogLevel -> LogLevel
pred :: LogLevel -> LogLevel
$ctoEnum :: Int -> LogLevel
toEnum :: Int -> LogLevel
$cfromEnum :: LogLevel -> Int
fromEnum :: LogLevel -> Int
$cenumFrom :: LogLevel -> [LogLevel]
enumFrom :: LogLevel -> [LogLevel]
$cenumFromThen :: LogLevel -> LogLevel -> [LogLevel]
enumFromThen :: LogLevel -> LogLevel -> [LogLevel]
$cenumFromTo :: LogLevel -> LogLevel -> [LogLevel]
enumFromTo :: LogLevel -> LogLevel -> [LogLevel]
$cenumFromThenTo :: LogLevel -> LogLevel -> LogLevel -> [LogLevel]
enumFromThenTo :: LogLevel -> LogLevel -> LogLevel -> [LogLevel]
Enum, LogLevel
LogLevel -> LogLevel -> Bounded LogLevel
forall a. a -> a -> Bounded a
$cminBound :: LogLevel
minBound :: LogLevel
$cmaxBound :: LogLevel
maxBound :: LogLevel
Bounded, (forall x. LogLevel -> Rep LogLevel x)
-> (forall x. Rep LogLevel x -> LogLevel) -> Generic LogLevel
forall x. Rep LogLevel x -> LogLevel
forall x. LogLevel -> Rep LogLevel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LogLevel -> Rep LogLevel x
from :: forall x. LogLevel -> Rep LogLevel x
$cto :: forall x. Rep LogLevel x -> LogLevel
to :: forall x. Rep LogLevel x -> LogLevel
Generic)

-- | A Rustls connection logging callback.
newtype LogCallback = LogCallback {LogCallback -> FunPtr LogCallback
unLogCallback :: FunPtr FFI.LogCallback}

-- | A 'Monad' to get TLS connection information via 'Rustls.handshake'.
newtype HandshakeQuery (side :: Side) a = HandshakeQuery (ReaderT Connection' IO a)
  deriving newtype ((forall a b.
 (a -> b) -> HandshakeQuery side a -> HandshakeQuery side b)
-> (forall a b.
    a -> HandshakeQuery side b -> HandshakeQuery side a)
-> Functor (HandshakeQuery side)
forall a b. a -> HandshakeQuery side b -> HandshakeQuery side a
forall a b.
(a -> b) -> HandshakeQuery side a -> HandshakeQuery side b
forall (side :: Side) a b.
a -> HandshakeQuery side b -> HandshakeQuery side a
forall (side :: Side) a b.
(a -> b) -> HandshakeQuery side a -> HandshakeQuery side b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (side :: Side) a b.
(a -> b) -> HandshakeQuery side a -> HandshakeQuery side b
fmap :: forall a b.
(a -> b) -> HandshakeQuery side a -> HandshakeQuery side b
$c<$ :: forall (side :: Side) a b.
a -> HandshakeQuery side b -> HandshakeQuery side a
<$ :: forall a b. a -> HandshakeQuery side b -> HandshakeQuery side a
Functor, Functor (HandshakeQuery side)
Functor (HandshakeQuery side) =>
(forall a. a -> HandshakeQuery side a)
-> (forall a b.
    HandshakeQuery side (a -> b)
    -> HandshakeQuery side a -> HandshakeQuery side b)
-> (forall a b c.
    (a -> b -> c)
    -> HandshakeQuery side a
    -> HandshakeQuery side b
    -> HandshakeQuery side c)
-> (forall a b.
    HandshakeQuery side a
    -> HandshakeQuery side b -> HandshakeQuery side b)
-> (forall a b.
    HandshakeQuery side a
    -> HandshakeQuery side b -> HandshakeQuery side a)
-> Applicative (HandshakeQuery side)
forall a. a -> HandshakeQuery side a
forall a b.
HandshakeQuery side a
-> HandshakeQuery side b -> HandshakeQuery side a
forall a b.
HandshakeQuery side a
-> HandshakeQuery side b -> HandshakeQuery side b
forall a b.
HandshakeQuery side (a -> b)
-> HandshakeQuery side a -> HandshakeQuery side b
forall a b c.
(a -> b -> c)
-> HandshakeQuery side a
-> HandshakeQuery side b
-> HandshakeQuery side c
forall (side :: Side). Functor (HandshakeQuery side)
forall (side :: Side) a. a -> HandshakeQuery side a
forall (side :: Side) a b.
HandshakeQuery side a
-> HandshakeQuery side b -> HandshakeQuery side a
forall (side :: Side) a b.
HandshakeQuery side a
-> HandshakeQuery side b -> HandshakeQuery side b
forall (side :: Side) a b.
HandshakeQuery side (a -> b)
-> HandshakeQuery side a -> HandshakeQuery side b
forall (side :: Side) a b c.
(a -> b -> c)
-> HandshakeQuery side a
-> HandshakeQuery side b
-> HandshakeQuery side c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall (side :: Side) a. a -> HandshakeQuery side a
pure :: forall a. a -> HandshakeQuery side a
$c<*> :: forall (side :: Side) a b.
HandshakeQuery side (a -> b)
-> HandshakeQuery side a -> HandshakeQuery side b
<*> :: forall a b.
HandshakeQuery side (a -> b)
-> HandshakeQuery side a -> HandshakeQuery side b
$cliftA2 :: forall (side :: Side) a b c.
(a -> b -> c)
-> HandshakeQuery side a
-> HandshakeQuery side b
-> HandshakeQuery side c
liftA2 :: forall a b c.
(a -> b -> c)
-> HandshakeQuery side a
-> HandshakeQuery side b
-> HandshakeQuery side c
$c*> :: forall (side :: Side) a b.
HandshakeQuery side a
-> HandshakeQuery side b -> HandshakeQuery side b
*> :: forall a b.
HandshakeQuery side a
-> HandshakeQuery side b -> HandshakeQuery side b
$c<* :: forall (side :: Side) a b.
HandshakeQuery side a
-> HandshakeQuery side b -> HandshakeQuery side a
<* :: forall a b.
HandshakeQuery side a
-> HandshakeQuery side b -> HandshakeQuery side a
Applicative, Applicative (HandshakeQuery side)
Applicative (HandshakeQuery side) =>
(forall a b.
 HandshakeQuery side a
 -> (a -> HandshakeQuery side b) -> HandshakeQuery side b)
-> (forall a b.
    HandshakeQuery side a
    -> HandshakeQuery side b -> HandshakeQuery side b)
-> (forall a. a -> HandshakeQuery side a)
-> Monad (HandshakeQuery side)
forall a. a -> HandshakeQuery side a
forall a b.
HandshakeQuery side a
-> HandshakeQuery side b -> HandshakeQuery side b
forall a b.
HandshakeQuery side a
-> (a -> HandshakeQuery side b) -> HandshakeQuery side b
forall (side :: Side). Applicative (HandshakeQuery side)
forall (side :: Side) a. a -> HandshakeQuery side a
forall (side :: Side) a b.
HandshakeQuery side a
-> HandshakeQuery side b -> HandshakeQuery side b
forall (side :: Side) a b.
HandshakeQuery side a
-> (a -> HandshakeQuery side b) -> HandshakeQuery side b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall (side :: Side) a b.
HandshakeQuery side a
-> (a -> HandshakeQuery side b) -> HandshakeQuery side b
>>= :: forall a b.
HandshakeQuery side a
-> (a -> HandshakeQuery side b) -> HandshakeQuery side b
$c>> :: forall (side :: Side) a b.
HandshakeQuery side a
-> HandshakeQuery side b -> HandshakeQuery side b
>> :: forall a b.
HandshakeQuery side a
-> HandshakeQuery side b -> HandshakeQuery side b
$creturn :: forall (side :: Side) a. a -> HandshakeQuery side a
return :: forall a. a -> HandshakeQuery side a
Monad)

type role HandshakeQuery nominal _

handshakeQuery :: (Connection' -> IO a) -> HandshakeQuery side a
handshakeQuery :: forall a (side :: Side).
(Connection' -> IO a) -> HandshakeQuery side a
handshakeQuery = (Connection' -> IO a) -> HandshakeQuery side a
forall a b. Coercible a b => a -> b
coerce

-- | TLS exception thrown by Rustls.
--
-- Use 'E.displayException' for a human-friendly representation.
newtype RustlsException = RustlsException {RustlsException -> Word32
rustlsErrorCode :: Word32}
  deriving stock (Int -> RustlsException -> ShowS
[RustlsException] -> ShowS
RustlsException -> String
(Int -> RustlsException -> ShowS)
-> (RustlsException -> String)
-> ([RustlsException] -> ShowS)
-> Show RustlsException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RustlsException -> ShowS
showsPrec :: Int -> RustlsException -> ShowS
$cshow :: RustlsException -> String
show :: RustlsException -> String
$cshowList :: [RustlsException] -> ShowS
showList :: [RustlsException] -> ShowS
Show)

instance E.Exception RustlsException where
  displayException :: RustlsException -> String
displayException RustlsException {Word32
rustlsErrorCode :: RustlsException -> Word32
rustlsErrorCode :: Word32
rustlsErrorCode} =
    [String] -> String
unwords
      [ String
"Rustls error:",
        Text -> String
T.unpack (Result -> Text
resultMsg (Word32 -> Result
FFI.Result Word32
rustlsErrorCode)),
        String
"(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word32 -> String
forall a. Show a => a -> String
show Word32
rustlsErrorCode String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
      ]

resultMsg :: FFI.Result -> Text
resultMsg :: Result -> Text
resultMsg Result
r = IO Text -> Text
forall a. IO a -> a
unsafePerformIO (IO Text -> Text) -> IO Text -> Text
forall a b. (a -> b) -> a -> b
$
  (Ptr CSize -> IO Text) -> IO Text
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr CSize
lenPtr -> Int -> (Ptr CChar -> IO Text) -> IO Text
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (CSize -> Int
cSizeToInt CSize
msgLen) \Ptr CChar
buf -> do
    Result -> Ptr CChar -> CSize -> Ptr CSize -> IO ()
FFI.errorMsg Result
r Ptr CChar
buf CSize
msgLen Ptr CSize
lenPtr
    len <- Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
lenPtr
    T.peekCStringLen (buf, cSizeToInt len)
  where
    msgLen :: CSize
msgLen = CSize
1024 -- a bit pessimistic?

-- | Checks if the given 'RustlsException' represents a certificate error.
isCertError :: RustlsException -> Bool
isCertError :: RustlsException -> Bool
isCertError RustlsException {Word32
rustlsErrorCode :: RustlsException -> Word32
rustlsErrorCode :: Word32
rustlsErrorCode} =
  forall a. (Eq a, Num a) => a -> Bool
toBool @CBool (CBool -> Bool) -> CBool -> Bool
forall a b. (a -> b) -> a -> b
$ Result -> CBool
FFI.resultIsCertError (Word32 -> Result
FFI.Result Word32
rustlsErrorCode)

rethrowR :: FFI.Result -> IO ()
rethrowR :: Result -> IO ()
rethrowR = \case
  Result
r | Result
r Result -> Result -> Bool
forall a. Eq a => a -> a -> Bool
== Result
FFI.resultOk -> IO ()
forall a. Monoid a => a
mempty
  FFI.Result Word32
rustlsErrorCode ->
    RustlsException -> IO ()
forall e a. (HasCallStack, Exception e) => e -> IO a
E.throwIO (RustlsException -> IO ()) -> RustlsException -> IO ()
forall a b. (a -> b) -> a -> b
$ Word32 -> RustlsException
RustlsException Word32
rustlsErrorCode

-- | Wrapper for exceptions thrown in a 'LogCallback'.
newtype RustlsLogException = RustlsLogException E.SomeException
  deriving stock (Int -> RustlsLogException -> ShowS
[RustlsLogException] -> ShowS
RustlsLogException -> String
(Int -> RustlsLogException -> ShowS)
-> (RustlsLogException -> String)
-> ([RustlsLogException] -> ShowS)
-> Show RustlsLogException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RustlsLogException -> ShowS
showsPrec :: Int -> RustlsLogException -> ShowS
$cshow :: RustlsLogException -> String
show :: RustlsLogException -> String
$cshowList :: [RustlsLogException] -> ShowS
showList :: [RustlsLogException] -> ShowS
Show)
  deriving anyclass (Show RustlsLogException
Typeable RustlsLogException
(Typeable RustlsLogException, Show RustlsLogException) =>
(RustlsLogException -> SomeException)
-> (SomeException -> Maybe RustlsLogException)
-> (RustlsLogException -> String)
-> (RustlsLogException -> Bool)
-> Exception RustlsLogException
SomeException -> Maybe RustlsLogException
RustlsLogException -> Bool
RustlsLogException -> String
RustlsLogException -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> (e -> Bool)
-> Exception e
$ctoException :: RustlsLogException -> SomeException
toException :: RustlsLogException -> SomeException
$cfromException :: SomeException -> Maybe RustlsLogException
fromException :: SomeException -> Maybe RustlsLogException
$cdisplayException :: RustlsLogException -> String
displayException :: RustlsLogException -> String
$cbacktraceDesired :: RustlsLogException -> Bool
backtraceDesired :: RustlsLogException -> Bool
E.Exception)

data RustlsUnknownLogLevel = RustlsUnknownLogLevel FFI.LogLevel
  deriving stock (Int -> RustlsUnknownLogLevel -> ShowS
[RustlsUnknownLogLevel] -> ShowS
RustlsUnknownLogLevel -> String
(Int -> RustlsUnknownLogLevel -> ShowS)
-> (RustlsUnknownLogLevel -> String)
-> ([RustlsUnknownLogLevel] -> ShowS)
-> Show RustlsUnknownLogLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RustlsUnknownLogLevel -> ShowS
showsPrec :: Int -> RustlsUnknownLogLevel -> ShowS
$cshow :: RustlsUnknownLogLevel -> String
show :: RustlsUnknownLogLevel -> String
$cshowList :: [RustlsUnknownLogLevel] -> ShowS
showList :: [RustlsUnknownLogLevel] -> ShowS
Show)
  deriving anyclass (Show RustlsUnknownLogLevel
Typeable RustlsUnknownLogLevel
(Typeable RustlsUnknownLogLevel, Show RustlsUnknownLogLevel) =>
(RustlsUnknownLogLevel -> SomeException)
-> (SomeException -> Maybe RustlsUnknownLogLevel)
-> (RustlsUnknownLogLevel -> String)
-> (RustlsUnknownLogLevel -> Bool)
-> Exception RustlsUnknownLogLevel
SomeException -> Maybe RustlsUnknownLogLevel
RustlsUnknownLogLevel -> Bool
RustlsUnknownLogLevel -> String
RustlsUnknownLogLevel -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> (e -> Bool)
-> Exception e
$ctoException :: RustlsUnknownLogLevel -> SomeException
toException :: RustlsUnknownLogLevel -> SomeException
$cfromException :: SomeException -> Maybe RustlsUnknownLogLevel
fromException :: SomeException -> Maybe RustlsUnknownLogLevel
$cdisplayException :: RustlsUnknownLogLevel -> String
displayException :: RustlsUnknownLogLevel -> String
$cbacktraceDesired :: RustlsUnknownLogLevel -> Bool
backtraceDesired :: RustlsUnknownLogLevel -> Bool
E.Exception)

-- | Underlying data source for Rustls.
data Backend = Backend
  { -- | Read data from the backend into the given buffer.
    Backend -> Ptr Word8 -> CSize -> IO CSize
backendRead ::
      -- Target buffer pointer.
      Ptr Word8 ->
      -- Target buffer length.
      CSize ->
      -- Amount of bytes read.
      IO CSize,
    -- | Write data from the given buffer to the backend.
    Backend -> Ptr Word8 -> CSize -> IO CSize
backendWrite ::
      -- Source buffer pointer.
      Ptr Word8 ->
      -- Source buffer length.
      CSize ->
      -- Amount of bytes written.
      IO CSize
  }

mkSocketBackend :: NS.Socket -> Backend
mkSocketBackend :: Socket -> Backend
mkSocketBackend Socket
s = Backend {Ptr Word8 -> CSize -> IO CSize
backendRead :: Ptr Word8 -> CSize -> IO CSize
backendWrite :: Ptr Word8 -> CSize -> IO CSize
backendRead :: Ptr Word8 -> CSize -> IO CSize
backendWrite :: Ptr Word8 -> CSize -> IO CSize
..}
  where
    backendRead :: Ptr Word8 -> CSize -> IO CSize
backendRead Ptr Word8
buf CSize
len =
      Int -> CSize
intToCSize (Int -> CSize) -> IO Int -> IO CSize
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Socket -> Ptr Word8 -> Int -> IO Int
NS.recvBuf Socket
s Ptr Word8
buf (CSize -> Int
cSizeToInt CSize
len)
    backendWrite :: Ptr Word8 -> CSize -> IO CSize
backendWrite Ptr Word8
buf CSize
len =
      Int -> CSize
intToCSize (Int -> CSize) -> IO Int -> IO CSize
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Socket -> Ptr Word8 -> Int -> IO Int
NS.sendBuf Socket
s Ptr Word8
buf (CSize -> Int
cSizeToInt CSize
len)

-- | An in-memory 'Backend'.
mkByteStringBackend ::
  -- | Read a 'ByteString' with the given max length.
  --
  -- This will silently truncate 'ByteString's which are too long.
  (Int -> IO ByteString) ->
  -- | Write a 'ByteString'.
  (ByteString -> IO ()) ->
  Backend
mkByteStringBackend :: (Int -> IO ByteString) -> (ByteString -> IO ()) -> Backend
mkByteStringBackend Int -> IO ByteString
bsbRead ByteString -> IO ()
bsbWrite = Backend {Ptr Word8 -> CSize -> IO CSize
forall {a}. Ptr a -> CSize -> IO CSize
backendRead :: Ptr Word8 -> CSize -> IO CSize
backendWrite :: Ptr Word8 -> CSize -> IO CSize
backendRead :: forall {a}. Ptr a -> CSize -> IO CSize
backendWrite :: forall {a}. Ptr a -> CSize -> IO CSize
..}
  where
    backendRead :: Ptr a -> CSize -> IO CSize
backendRead Ptr a
buf CSize
len = do
      bs <- Int -> IO ByteString
bsbRead (CSize -> Int
cSizeToInt CSize
len)
      BU.unsafeUseAsCStringLen bs \(Ptr CChar
bsPtr, Int
bsLen) -> do
        let copyLen :: Int
copyLen = Int
bsLen Int -> Int -> Int
forall a. Ord a => a -> a -> a
`min` CSize -> Int
cSizeToInt CSize
len
        Ptr a -> Ptr a -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr a
buf (Ptr CChar -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
bsPtr) Int
copyLen
        CSize -> IO CSize
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CSize -> IO CSize) -> CSize -> IO CSize
forall a b. (a -> b) -> a -> b
$ Int -> CSize
intToCSize Int
copyLen
    backendWrite :: Ptr a -> CSize -> IO CSize
backendWrite Ptr a
buf CSize
len = do
      ByteString -> IO ()
bsbWrite (ByteString -> IO ()) -> IO ByteString -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CStringLen -> IO ByteString
B.packCStringLen (Ptr a -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr a
buf, CSize -> Int
cSizeToInt CSize
len)
      CSize -> IO CSize
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CSize
len

-- | Type-level indicator whether a 'Connection' is client- or server-side.
data Side = Client | Server

-- | A Rustls connection.
newtype Connection (side :: Side) = Connection (MVar Connection')

type role Connection nominal

data Connection' = Connection'
  { Connection' -> Ptr Connection
conn :: Ptr FFI.Connection,
    Connection' -> Backend
backend :: Backend,
    Connection' -> Ptr CSize
lenPtr :: Ptr CSize,
    Connection' -> MVar IOMsgReq
ioMsgReq :: MVar IOMsgReq,
    Connection' -> MVar IOMsgRes
ioMsgRes :: MVar IOMsgRes,
    Connection' -> ThreadId
interactThread :: ThreadId
  }

withConnection :: Connection side -> (Connection' -> IO a) -> IO a
withConnection :: forall (side :: Side) a.
Connection side -> (Connection' -> IO a) -> IO a
withConnection (Connection MVar Connection'
c) = MVar Connection' -> (Connection' -> IO a) -> IO a
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar Connection'
c

data ReadOrWrite = Read | Write

-- GHC will delay async exceptions to (non-interruptible) FFI calls until they
-- finish. In particular, this means that when a (safe) FFI call invokes a
-- Haskell callback, it is uncancelable. As usages of this library will most
-- likely involve actual I/O (which really should be able to be cancelled), we
-- invoke the respective FFI functions (which will themselves then call back
-- into Haskell) in a separate thread, and interact with it via message passing
-- (see the 'IOMsgReq' and 'IOMsgRes' types).

-- | Messages sent to the background thread.
data IOMsgReq
  = -- | Request to start a read or a write FFI call from the background thread.
    -- It should respond with 'UsingBuffer'.
    Request ReadOrWrite
  | -- | Notify the background thread that we are done interacting with the
    -- buffer.
    Done FFI.IOResult

-- | Messages sent from the background thread.
data IOMsgRes
  = -- | Reply with a buffer, either containing the read data, or awaiting a
    -- write to this buffer.
    UsingBuffer (Ptr Word8) CSize (Ptr CSize)
  | -- | Notify that the FFI call finished.
    DoneFFI

interactTLS :: Connection' -> ReadOrWrite -> IO CSize
interactTLS :: Connection' -> ReadOrWrite -> IO CSize
interactTLS Connection' {Ptr CSize
Ptr Connection
ThreadId
MVar IOMsgRes
MVar IOMsgReq
Backend
conn :: Connection' -> Ptr Connection
backend :: Connection' -> Backend
lenPtr :: Connection' -> Ptr CSize
ioMsgReq :: Connection' -> MVar IOMsgReq
ioMsgRes :: Connection' -> MVar IOMsgRes
interactThread :: Connection' -> ThreadId
conn :: Ptr Connection
backend :: Backend
lenPtr :: Ptr CSize
ioMsgReq :: MVar IOMsgReq
ioMsgRes :: MVar IOMsgRes
interactThread :: ThreadId
..} ReadOrWrite
readOrWrite = ((forall a. IO a -> IO a) -> IO CSize) -> IO CSize
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
E.uninterruptibleMask \forall a. IO a -> IO a
restore -> do
  MVar IOMsgReq -> IOMsgReq -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar IOMsgReq
ioMsgReq (IOMsgReq -> IO ()) -> IOMsgReq -> IO ()
forall a b. (a -> b) -> a -> b
$ ReadOrWrite -> IOMsgReq
Request ReadOrWrite
readOrWrite
  UsingBuffer buf len sizePtr <- MVar IOMsgRes -> IO IOMsgRes
forall a. MVar a -> IO a
takeMVar MVar IOMsgRes
ioMsgRes
  size <-
    restore (readOrWriteBackend buf len)
      `E.onException` done FFI.ioResultErr
  poke sizePtr size
  done FFI.ioResultOk
  pure size
  where
    readOrWriteBackend :: Ptr Word8 -> CSize -> IO CSize
readOrWriteBackend = case ReadOrWrite
readOrWrite of
      ReadOrWrite
Read -> Backend -> Ptr Word8 -> CSize -> IO CSize
backendRead Backend
backend
      ReadOrWrite
Write -> Backend -> Ptr Word8 -> CSize -> IO CSize
backendWrite Backend
backend
    done :: IOResult -> IO ()
done IOResult
ioResult = do
      MVar IOMsgReq -> IOMsgReq -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar IOMsgReq
ioMsgReq (IOMsgReq -> IO ()) -> IOMsgReq -> IO ()
forall a b. (a -> b) -> a -> b
$ IOResult -> IOMsgReq
Done IOResult
ioResult
      IOMsgRes -> IO ()
DoneFFI <- MVar IOMsgRes -> IO IOMsgRes
forall a. MVar a -> IO a
takeMVar MVar IOMsgRes
ioMsgRes
      pure ()

data IsEOF = IsEOF | NotEOF
  deriving stock (Int -> IsEOF -> ShowS
[IsEOF] -> ShowS
IsEOF -> String
(Int -> IsEOF -> ShowS)
-> (IsEOF -> String) -> ([IsEOF] -> ShowS) -> Show IsEOF
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IsEOF -> ShowS
showsPrec :: Int -> IsEOF -> ShowS
$cshow :: IsEOF -> String
show :: IsEOF -> String
$cshowList :: [IsEOF] -> ShowS
showList :: [IsEOF] -> ShowS
Show, IsEOF -> IsEOF -> Bool
(IsEOF -> IsEOF -> Bool) -> (IsEOF -> IsEOF -> Bool) -> Eq IsEOF
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IsEOF -> IsEOF -> Bool
== :: IsEOF -> IsEOF -> Bool
$c/= :: IsEOF -> IsEOF -> Bool
/= :: IsEOF -> IsEOF -> Bool
Eq)

-- | Helper function, see @complete_io@ from rustls.
--
-- <https://github.com/rustls/rustls/blob/v/0.23.4/rustls/src/conn.rs#L544>
completeIO :: Connection' -> IO IsEOF
completeIO :: Connection' -> IO IsEOF
completeIO c :: Connection'
c@Connection' {Ptr CSize
Ptr Connection
ThreadId
MVar IOMsgRes
MVar IOMsgReq
Backend
conn :: Connection' -> Ptr Connection
backend :: Connection' -> Backend
lenPtr :: Connection' -> Ptr CSize
ioMsgReq :: Connection' -> MVar IOMsgReq
ioMsgRes :: Connection' -> MVar IOMsgRes
interactThread :: Connection' -> ThreadId
conn :: Ptr Connection
backend :: Backend
lenPtr :: Ptr CSize
ioMsgReq :: MVar IOMsgReq
ioMsgRes :: MVar IOMsgRes
interactThread :: ThreadId
..} = IsEOF -> IO IsEOF
go IsEOF
NotEOF
  where
    go :: IsEOF -> IO IsEOF
go IsEOF
eof = do
      untilHandshaked <- Connection' -> IO Bool
getIsHandshaking Connection'
c
      atLeastOneWrite <- getWantsWrite c

      loopWhileTrue runWrite

      if not untilHandshaked && atLeastOneWrite
        then pure eof
        else do
          wantsRead <- getWantsRead c
          eof <-
            if eof == NotEOF && wantsRead
              then do
                bytesRead <- interactTLS c Read
                pure if bytesRead == 0 then IsEOF else NotEOF
              else pure eof

          r <- FFI.connectionProcessNewPackets conn
          -- try to notify our peer that we encountered a TLS error
          when (r /= FFI.resultOk) $ ignoreSyncExceptions $ void runWrite
          rethrowR r

          stillHandshaking <- getIsHandshaking c
          finished <- case (untilHandshaked, stillHandshaking) of
            (Bool
True, Bool
False) -> Bool -> Bool
not (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection' -> IO Bool
getWantsWrite Connection'
c
            (Bool
False, Bool
_) -> Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
            (Bool
True, Bool
True) -> do
              Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (IsEOF
eof IsEOF -> IsEOF -> Bool
forall a. Eq a => a -> a -> Bool
== IsEOF
IsEOF) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"rustls: unexpected eof"
              Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
          if finished then pure eof else go eof

    runWrite :: IO Bool
runWrite = do
      wantsWrite <- Connection' -> IO Bool
getWantsWrite Connection'
c
      when wantsWrite $ void $ interactTLS c Write
      pure wantsWrite

completePriorIO :: Connection' -> IO ()
completePriorIO :: Connection' -> IO ()
completePriorIO Connection'
c = do
  IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (Connection' -> IO Bool
getIsHandshaking Connection'
c) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO IsEOF -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO IsEOF -> IO ()) -> IO IsEOF -> IO ()
forall a b. (a -> b) -> a -> b
$ Connection' -> IO IsEOF
completeIO Connection'
c
  IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (Connection' -> IO Bool
getWantsWrite Connection'
c) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO IsEOF -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO IsEOF -> IO ()) -> IO IsEOF -> IO ()
forall a b. (a -> b) -> a -> b
$ Connection' -> IO IsEOF
completeIO Connection'
c

getIsHandshaking :: Connection' -> IO Bool
getIsHandshaking :: Connection' -> IO Bool
getIsHandshaking Connection' {Ptr Connection
conn :: Connection' -> Ptr Connection
conn :: Ptr Connection
conn} =
  forall a. (Eq a, Num a) => a -> Bool
toBool @CBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConstPtr Connection -> IO CBool
FFI.connectionIsHandshaking (Ptr Connection -> ConstPtr Connection
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr Connection
conn)

getWantsRead :: Connection' -> IO Bool
getWantsRead :: Connection' -> IO Bool
getWantsRead Connection' {Ptr Connection
conn :: Connection' -> Ptr Connection
conn :: Ptr Connection
conn} =
  forall a. (Eq a, Num a) => a -> Bool
toBool @CBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConstPtr Connection -> IO CBool
FFI.connectionWantsRead (Ptr Connection -> ConstPtr Connection
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr Connection
conn)

getWantsWrite :: Connection' -> IO Bool
getWantsWrite :: Connection' -> IO Bool
getWantsWrite Connection' {Ptr Connection
conn :: Connection' -> Ptr Connection
conn :: Ptr Connection
conn} =
  forall a. (Eq a, Num a) => a -> Bool
toBool @CBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConstPtr Connection -> IO CBool
FFI.connectionWantsWrite (Ptr Connection -> ConstPtr Connection
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr Connection
conn)

-- utils

whenM :: (Monad m) => m Bool -> m () -> m ()
whenM :: forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM m Bool
cond m ()
action = m Bool
cond m Bool -> (Bool -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case Bool
True -> m ()
action; Bool
False -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

loopWhileTrue :: (Monad m) => m Bool -> m ()
loopWhileTrue :: forall (m :: * -> *). Monad m => m Bool -> m ()
loopWhileTrue m Bool
action = m Bool -> m () -> m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM m Bool
action (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ m Bool -> m ()
forall (m :: * -> *). Monad m => m Bool -> m ()
loopWhileTrue m Bool
action

cSizeToInt :: CSize -> Int
cSizeToInt :: CSize -> Int
cSizeToInt = CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE cSizeToInt #-}

intToCSize :: Int -> CSize
intToCSize :: Int -> CSize
intToCSize = Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE intToCSize #-}

strToText :: FFI.Str -> IO Text
strToText :: Str -> IO Text
strToText (FFI.Str Ptr CChar
buf CSize
len) = CStringLen -> IO Text
T.peekCStringLen (Ptr CChar
buf, CSize -> Int
cSizeToInt CSize
len)

ignoreExceptions :: IO () -> IO ()
ignoreExceptions :: IO () -> IO ()
ignoreExceptions = IO (Either SomeException ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Either SomeException ()) -> IO ())
-> (IO () -> IO (Either SomeException ())) -> IO () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => IO a -> IO (Either e a)
E.try @E.SomeException

ignoreSyncExceptions :: IO () -> IO ()
ignoreSyncExceptions :: IO () -> IO ()
ignoreSyncExceptions = (SomeException -> IO ()) -> IO () -> IO ()
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
E.handle \case
  (SomeException -> Maybe SomeAsyncException
forall e. Exception e => SomeException -> Maybe e
E.fromException -> Just e :: SomeAsyncException
e@(E.SomeAsyncException e
_)) -> SomeAsyncException -> IO ()
forall e a. (HasCallStack, Exception e) => e -> IO a
E.throwIO SomeAsyncException
e
  SomeException
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()