Safe Haskell | None |
---|---|
Language | Haskell2010 |
Internal module, not subject to PVP.
Synopsis
- newtype ALPNProtocol = ALPNProtocol {}
- newtype CipherSuite = CipherSuite (Ptr SupportedCipherSuite)
- cipherSuiteID :: CipherSuite -> Word16
- showCipherSuite :: CipherSuite -> Text
- data ClientConfigBuilder = ClientConfigBuilder {}
- data ClientRoots
- data PEMCertificates
- data CertifiedKey = CertifiedKey {}
- data ClientConfig = ClientConfig {}
- data ClientCertVerifier
- data ServerConfigBuilder = ServerConfigBuilder {}
- data ServerConfig = ServerConfig {}
- data LogLevel
- newtype LogCallback = LogCallback {}
- newtype HandshakeQuery (side :: Side) a = HandshakeQuery (ReaderT Connection' IO a)
- handshakeQuery :: (Connection' -> IO a) -> HandshakeQuery side a
- newtype RustlsException = RustlsException {}
- resultMsg :: Result -> Text
- isCertError :: RustlsException -> Bool
- rethrowR :: Result -> IO ()
- class Backend b where
- data ByteStringBackend = ByteStringBackend {
- bsbRead :: Int -> IO ByteString
- bsbWrite :: ByteString -> IO ()
- data Side
- newtype Connection (side :: Side) = Connection (MVar Connection')
- data Connection' = forall b.Backend b => Connection' {}
- withConnection :: Connection side -> (Connection' -> IO a) -> IO a
- data ReadOrWrite
- data IOMsgReq
- data IOMsgRes
- interactTLS :: Connection' -> ReadOrWrite -> IO ()
- data RunTLSMode
- runTLS :: Connection' -> RunTLSMode -> IO ()
- cSizeToInt :: CSize -> Int
- intToCSize :: Int -> CSize
- strToText :: Str -> IO Text
- ignoreExceptions :: IO () -> IO ()
- ignoreSyncExceptions :: IO () -> IO ()
Documentation
newtype ALPNProtocol Source #
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.
Instances
newtype CipherSuite Source #
A TLS cipher suite supported by Rustls.
Instances
Eq CipherSuite Source # | |
Defined in Rustls.Internal (==) :: CipherSuite -> CipherSuite -> Bool # (/=) :: CipherSuite -> CipherSuite -> Bool # | |
Ord CipherSuite Source # | |
Defined in Rustls.Internal compare :: CipherSuite -> CipherSuite -> Ordering # (<) :: CipherSuite -> CipherSuite -> Bool # (<=) :: CipherSuite -> CipherSuite -> Bool # (>) :: CipherSuite -> CipherSuite -> Bool # (>=) :: CipherSuite -> CipherSuite -> Bool # max :: CipherSuite -> CipherSuite -> CipherSuite # min :: CipherSuite -> CipherSuite -> CipherSuite # | |
Show CipherSuite Source # | |
Defined in Rustls.Internal showsPrec :: Int -> CipherSuite -> ShowS # show :: CipherSuite -> String # showList :: [CipherSuite] -> ShowS # |
cipherSuiteID :: CipherSuite -> Word16 Source #
Get the IANA value from a 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.
showCipherSuite :: CipherSuite -> Text Source #
Get the text representation of a cipher suite.
data ClientConfigBuilder Source #
Rustls client config builder.
ClientConfigBuilder | |
|
Instances
data ClientRoots Source #
How to look up root certificates.
ClientRootsFromFile FilePath | Fetch PEM-encoded root certificates from a file. |
ClientRootsInMemory [PEMCertificates] | Use in-memory PEM-encoded certificates. |
Instances
Show ClientRoots Source # | |
Defined in Rustls.Internal showsPrec :: Int -> ClientRoots -> ShowS # show :: ClientRoots -> String # showList :: [ClientRoots] -> ShowS # | |
Generic ClientRoots Source # | |
Defined in Rustls.Internal type Rep ClientRoots :: Type -> Type # from :: ClientRoots -> Rep ClientRoots x # to :: Rep ClientRoots x -> ClientRoots # | |
type Rep ClientRoots Source # | |
Defined in Rustls.Internal type Rep ClientRoots = D1 ('MetaData "ClientRoots" "Rustls.Internal" "rustls-0.0.0.0-inplace" 'False) (C1 ('MetaCons "ClientRootsFromFile" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 FilePath)) :+: C1 ('MetaCons "ClientRootsInMemory" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 [PEMCertificates]))) |
data PEMCertificates Source #
In-memory PEM-encoded certificates.
PEMCertificatesStrict ByteString | Syntactically valid PEM-encoded certificates. |
PEMCertificatesLax ByteString | PEM-encoded certificates, ignored if syntactically invalid. This may be useful on systems that have syntactically invalid root certificates. |
Instances
Show PEMCertificates Source # | |
Defined in Rustls.Internal showsPrec :: Int -> PEMCertificates -> ShowS # show :: PEMCertificates -> String # showList :: [PEMCertificates] -> ShowS # | |
Generic PEMCertificates Source # | |
Defined in Rustls.Internal type Rep PEMCertificates :: Type -> Type # from :: PEMCertificates -> Rep PEMCertificates x # to :: Rep PEMCertificates x -> PEMCertificates # | |
type Rep PEMCertificates Source # | |
Defined in Rustls.Internal type Rep PEMCertificates = D1 ('MetaData "PEMCertificates" "Rustls.Internal" "rustls-0.0.0.0-inplace" 'False) (C1 ('MetaCons "PEMCertificatesStrict" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 ByteString)) :+: C1 ('MetaCons "PEMCertificatesLax" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 ByteString))) |
data CertifiedKey Source #
A complete chain of certificates plus a private key for the leaf certificate.
CertifiedKey | |
|
Instances
Show CertifiedKey Source # | |
Defined in Rustls.Internal showsPrec :: Int -> CertifiedKey -> ShowS # show :: CertifiedKey -> String # showList :: [CertifiedKey] -> ShowS # | |
Generic CertifiedKey Source # | |
Defined in Rustls.Internal type Rep CertifiedKey :: Type -> Type # from :: CertifiedKey -> Rep CertifiedKey x # to :: Rep CertifiedKey x -> CertifiedKey # | |
type Rep CertifiedKey Source # | |
Defined in Rustls.Internal type Rep CertifiedKey = D1 ('MetaData "CertifiedKey" "Rustls.Internal" "rustls-0.0.0.0-inplace" 'False) (C1 ('MetaCons "CertifiedKey" 'PrefixI 'True) (S1 ('MetaSel ('Just "certificateChain") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 ByteString) :*: S1 ('MetaSel ('Just "privateKey") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 ByteString))) |
data ClientConfig Source #
Assembled configuration for a Rustls client connection.
ClientConfig | |
|
data ClientCertVerifier Source #
How to verify TLS client certificates.
ClientCertVerifier [PEMCertificates] | Root certificates used to verify TLS client certificates. |
ClientCertVerifierOptional [PEMCertificates] | Root certificates used to verify TLS client certificates if present, but does not reject clients which provide no certificate. |
Instances
Show ClientCertVerifier Source # | |
Defined in Rustls.Internal showsPrec :: Int -> ClientCertVerifier -> ShowS # show :: ClientCertVerifier -> String # showList :: [ClientCertVerifier] -> ShowS # | |
Generic ClientCertVerifier Source # | |
Defined in Rustls.Internal type Rep ClientCertVerifier :: Type -> Type # from :: ClientCertVerifier -> Rep ClientCertVerifier x # to :: Rep ClientCertVerifier x -> ClientCertVerifier # | |
type Rep ClientCertVerifier Source # | |
Defined in Rustls.Internal type Rep ClientCertVerifier = D1 ('MetaData "ClientCertVerifier" "Rustls.Internal" "rustls-0.0.0.0-inplace" 'False) (C1 ('MetaCons "ClientCertVerifier" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 [PEMCertificates])) :+: C1 ('MetaCons "ClientCertVerifierOptional" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 [PEMCertificates]))) |
data ServerConfigBuilder Source #
Rustls client config builder.
ServerConfigBuilder | |
|
Instances
data ServerConfig Source #
Assembled configuration for a Rustls server connection.
ServerConfig | |
|
Rustls log level.
Instances
Bounded LogLevel Source # | |
Enum LogLevel Source # | |
Eq LogLevel Source # | |
Ord LogLevel Source # | |
Defined in Rustls.Internal | |
Show LogLevel Source # | |
Generic LogLevel Source # | |
type Rep LogLevel Source # | |
Defined in Rustls.Internal type Rep LogLevel = D1 ('MetaData "LogLevel" "Rustls.Internal" "rustls-0.0.0.0-inplace" 'False) ((C1 ('MetaCons "LogLevelError" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "LogLevelWarn" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "LogLevelInfo" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "LogLevelDebug" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "LogLevelTrace" 'PrefixI 'False) (U1 :: Type -> Type)))) |
newtype LogCallback Source #
A Rustls connection logging callback.
newtype HandshakeQuery (side :: Side) a Source #
Instances
Monad (HandshakeQuery side) Source # | |
Defined in Rustls.Internal (>>=) :: HandshakeQuery side a -> (a -> HandshakeQuery side b) -> HandshakeQuery side b # (>>) :: HandshakeQuery side a -> HandshakeQuery side b -> HandshakeQuery side b # return :: a -> HandshakeQuery side a # | |
Functor (HandshakeQuery side) Source # | |
Defined in Rustls.Internal fmap :: (a -> b) -> HandshakeQuery side a -> HandshakeQuery side b # (<$) :: a -> HandshakeQuery side b -> HandshakeQuery side a # | |
Applicative (HandshakeQuery side) Source # | |
Defined in Rustls.Internal pure :: a -> HandshakeQuery side a # (<*>) :: HandshakeQuery side (a -> b) -> HandshakeQuery side a -> HandshakeQuery side b # liftA2 :: (a -> b -> c) -> HandshakeQuery side a -> HandshakeQuery side b -> HandshakeQuery side c # (*>) :: HandshakeQuery side a -> HandshakeQuery side b -> HandshakeQuery side b # (<*) :: HandshakeQuery side a -> HandshakeQuery side b -> HandshakeQuery side a # |
handshakeQuery :: (Connection' -> IO a) -> HandshakeQuery side a Source #
newtype RustlsException Source #
TLS exception thrown by Rustls.
Use displayException
for a human-friendly representation.
Instances
Show RustlsException Source # | |
Defined in Rustls.Internal showsPrec :: Int -> RustlsException -> ShowS # show :: RustlsException -> String # showList :: [RustlsException] -> ShowS # | |
Exception RustlsException Source # | |
Defined in Rustls.Internal |
isCertError :: RustlsException -> Bool Source #
Checks if the given RustlsException
represents a certificate error.
class Backend b where Source #
Underlying data sources for Rustls.
:: b | |
-> Ptr Word8 | Target buffer pointer. |
-> CSize | Target buffer length. |
-> IO CSize | Amount of bytes read. |
Read data from the backend into the given buffer.
:: b | |
-> Ptr Word8 | Source buffer pointer. |
-> CSize | Source buffer length. |
-> IO CSize | Amount of bytes written. |
Write data from the given buffer to the backend.
Instances
Backend Socket Source # | |
Backend ByteStringBackend Source # | This instance will silently truncate |
Defined in Rustls.Internal backendRead :: ByteStringBackend -> Ptr Word8 -> CSize -> IO CSize Source # backendWrite :: ByteStringBackend -> Ptr Word8 -> CSize -> IO CSize Source # |
data ByteStringBackend Source #
An in-memory Backend
.
ByteStringBackend | |
|
Instances
Generic ByteStringBackend Source # | |
Defined in Rustls.Internal type Rep ByteStringBackend :: Type -> Type # from :: ByteStringBackend -> Rep ByteStringBackend x # to :: Rep ByteStringBackend x -> ByteStringBackend # | |
Backend ByteStringBackend Source # | This instance will silently truncate |
Defined in Rustls.Internal backendRead :: ByteStringBackend -> Ptr Word8 -> CSize -> IO CSize Source # backendWrite :: ByteStringBackend -> Ptr Word8 -> CSize -> IO CSize Source # | |
type Rep ByteStringBackend Source # | |
Defined in Rustls.Internal type Rep ByteStringBackend = D1 ('MetaData "ByteStringBackend" "Rustls.Internal" "rustls-0.0.0.0-inplace" 'False) (C1 ('MetaCons "ByteStringBackend" 'PrefixI 'True) (S1 ('MetaSel ('Just "bsbRead") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Int -> IO ByteString)) :*: S1 ('MetaSel ('Just "bsbWrite") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (ByteString -> IO ())))) |
data Connection' Source #
withConnection :: Connection side -> (Connection' -> IO a) -> IO a Source #
data ReadOrWrite Source #
Messages sent to the background thread.
Request ReadOrWrite | Request to start a read or a write FFI call from the background thread.
It should respond with |
Done IOResult | Notify the background thread that we are done interacting with the buffer. |
Messages sent from the background thread.
interactTLS :: Connection' -> ReadOrWrite -> IO () Source #
data RunTLSMode Source #
Instances
Eq RunTLSMode Source # | |
Defined in Rustls.Internal (==) :: RunTLSMode -> RunTLSMode -> Bool # (/=) :: RunTLSMode -> RunTLSMode -> Bool # |
runTLS :: Connection' -> RunTLSMode -> IO () Source #
cSizeToInt :: CSize -> Int Source #
intToCSize :: Int -> CSize Source #
ignoreExceptions :: IO () -> IO () Source #
ignoreSyncExceptions :: IO () -> IO () Source #