Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
This module exports simple tools for establishing TLS-secured TCP connections, relevant to both the client side and server side of the connection.
This module re-exports some functions from the Network.Simple.TCP module in the network-simple package. Consider using that module directly if you need a similar API without TLS support.
This module uses MonadIO
and MonadMask
extensively so that you can
reuse these functions in monads other than IO
. However, if you don't care
about any of that, just pretend you are using the IO
monad all the time and
everything will work as expected.
Synopsis
- serve :: MonadIO m => ServerParams -> HostPreference -> ServiceName -> ((Context, SockAddr) -> IO ()) -> m ()
- listen :: (MonadIO m, MonadMask m) => HostPreference -> ServiceName -> ((Socket, SockAddr) -> m r) -> m r
- accept :: (MonadIO m, MonadMask m) => ServerParams -> Socket -> ((Context, SockAddr) -> m r) -> m r
- acceptFork :: MonadIO m => ServerParams -> Socket -> ((Context, SockAddr) -> IO ()) -> m ThreadId
- newDefaultServerParams :: MonadIO m => Credential -> m ServerParams
- makeServerParams :: Credential -> Maybe CertificateStore -> ServerParams
- connect :: (MonadIO m, MonadMask m) => ClientParams -> HostName -> ServiceName -> ((Context, SockAddr) -> m r) -> m r
- connectOverSOCKS5 :: (MonadIO m, MonadMask m) => HostName -> ServiceName -> ClientParams -> HostName -> ServiceName -> ((Context, SockAddr, SockAddr) -> m r) -> m r
- newDefaultClientParams :: MonadIO m => ServiceID -> m ClientParams
- makeClientParams :: ServiceID -> [Credential] -> CertificateStore -> ClientParams
- recv :: MonadIO m => Context -> m (Maybe ByteString)
- send :: MonadIO m => Context -> ByteString -> m ()
- sendLazy :: MonadIO m => Context -> ByteString -> m ()
- useTls :: (MonadIO m, MonadMask m) => ((Context, SockAddr) -> m a) -> (Context, SockAddr) -> m a
- useTlsThenClose :: (MonadIO m, MonadMask m) => ((Context, SockAddr) -> m a) -> (Context, SockAddr) -> m a
- useTlsThenCloseFork :: MonadIO m => ((Context, SockAddr) -> IO ()) -> (Context, SockAddr) -> m ThreadId
- connectTls :: MonadIO m => ClientParams -> HostName -> ServiceName -> m (Context, SockAddr)
- connectTlsOverSOCKS5 :: MonadIO m => HostName -> ServiceName -> ClientParams -> HostName -> ServiceName -> m (Context, SockAddr, SockAddr)
- acceptTls :: MonadIO m => ServerParams -> Socket -> m (Context, SockAddr)
- makeClientContext :: MonadIO m => ClientParams -> Socket -> m Context
- makeServerContext :: MonadIO m => ServerParams -> Socket -> m Context
- withSocketsDo :: IO a -> IO a
- data HostPreference
- type HostName = String
- type ServiceName = String
- data Socket
- data SockAddr
- data Context
- data ClientParams
- data ServerParams
- type Credential = (CertificateChain, PrivKey)
- credentialLoadX509 :: MonadIO m => FilePath -> FilePath -> m (Either String Credential)
Server side
:: MonadIO m | |
=> ServerParams | TLS settings. |
-> HostPreference | Preferred host to bind. |
-> ServiceName | Service port to bind. |
-> ((Context, SockAddr) -> IO ()) | Computation to run in a different thread once an incomming connection is accepted and a TLS-secured communication is established. Takes the TLS connection context and remote end address. |
-> m () |
Start a TLS-secured TCP server that accepts incoming connections and handles each of them concurrently, in different threads.
Any acquired network resources are properly closed and discarded when done or in case of exceptions. This function binds a listening socket, accepts an incoming connection, performs a TLS handshake and then safely closes the connection when done or in case of exceptions. You don't need to perform any of those steps manually.
Listening
:: (MonadIO m, MonadMask m) | |
=> HostPreference | Host to bind. |
-> ServiceName | Server service port name or number to bind. |
-> ((Socket, SockAddr) -> m r) | Computation taking the listening socket and the address it's bound to. |
-> m r |
Bind a TCP listening socket and use it.
The listening socket is closed when done or in case of exceptions.
If you prefer to acquire and close the socket yourself, then use bindSock
and closeSock
, as well as listenSock
function.
Note: The NoDelay
, KeepAlive
and ReuseAddr
options are set on
the socket. The maximum number of incoming queued connections is 2048.
Accepting
:: (MonadIO m, MonadMask m) | |
=> ServerParams | TLS settings. |
-> Socket | Listening and bound socket. |
-> ((Context, SockAddr) -> m r) | Computation to run in a different thread once an incomming connection is accepted and a TLS-secured communication is established. Takes the TLS connection context and remote end address. |
-> m r |
Accepts a single incomming TLS-secured TCP connection and use it.
A TLS handshake is performed immediately after establishing the TCP
connection and the TLS and TCP connections are properly closed when done or
in case of exceptions. If you need to manage the lifetime of the connection
resources yourself, then use acceptTls
instead.
:: MonadIO m | |
=> ServerParams | TLS settings. |
-> Socket | Listening and bound socket. |
-> ((Context, SockAddr) -> IO ()) | Computation to run in a different thread once an incomming connection is accepted and a TLS-secured communication is established. Takes the TLS connection context and remote end address. |
-> m ThreadId |
Like accept
, except it uses a different thread to performs the TLS
handshake and run the given computation.
Server TLS Settings
newDefaultServerParams Source #
:: MonadIO m | |
=> Credential | Server credential. Can be loaded with |
-> m ServerParams |
Obtain new default ServerParams
for a particular server Credential
.
- Don't require credentials from clients.
- Use an in-memory TLS session manager from the tls-session-manager package.
- Everything else as proposed by
makeServerParams
.
:: Credential | Server credential. Can be loaded with |
-> Maybe CertificateStore | CAs used to verify the client certificate. If specified, then a valid client certificate will be expected during handshake. Use |
-> ServerParams |
Make default ServerParams
.
- The supported cipher suites are those enumerated by
ciphersuite_strong
, in decreasing order of preference. The cipher suite preferred by the server is used. - Secure renegotiation initiated by the server is enabled, but renegotiation initiated by the client is disabled.
- Only the TLS 1.1, TLS 1.2 and TLS 1.3 protocols are supported by default.
If you are unsatisfied with any of these settings, please
please refer to the Network.TLS module for more documentation on
ServerParams
.
Client side
:: (MonadIO m, MonadMask m) | |
=> ClientParams | TLS settings. |
-> HostName | Server hostname. |
-> ServiceName | Destination server service port name or number. |
-> ((Context, SockAddr) -> m r) | Computation to run after establishing TLS-secured TCP connection to the remote server. Takes the TLS connection context and remote end address. |
-> m r |
Connect to a TLS-secured TCP server and use the connection
A TLS handshake is performed immediately after establishing the TCP
connection and the TLS and TCP connections are properly closed when done or
in case of exceptions. If you need to manage the lifetime of the connection
resources yourself, then use connectTls
instead.
:: (MonadIO m, MonadMask m) | |
=> HostName | SOCKS5 proxy server hostname or IP address. |
-> ServiceName | SOCKS5 proxy server service port name or number. |
-> ClientParams | TLS settings. |
-> HostName | Destination server hostname or IP address. We connect to this host through the SOCKS5 proxy specified in the previous arguments. Note that if hostname resolution on this |
-> ServiceName | Destination server service port name or number. |
-> ((Context, SockAddr, SockAddr) -> m r) | Computation to run after establishing TLS-secured TCP connection to the remote server. Takes the TLS connection that can be used to interact with the destination server, as well as the address of the SOCKS5 server and the address of the destination server, in that order. |
-> m r |
Like connect
, but connects to the destination server over a SOCKS5 proxy.
Client TLS Settings
newDefaultClientParams Source #
:: MonadIO m | |
=> ServiceID |
Identification of the connection consisting of the fully qualified host name for the server (e.g. www.example.com) and an optional suffix. It is important that the hostname part is properly filled for security reasons, as it allow to properly associate the remote side with the given certificate during a handshake. The suffix is used to identity a certificate per service on a specific
host. For example, a same host might have different certificates on
differents ports (443 and 995). For TCP connections, it's recommended
to use: |
-> m ClientParams |
Obtain new default ClientParams
for a particular ServiceID
.
- No client credentials sumbitted to the server.
- Use system-wide CA certificate store.
- Use an in-memory TLS session manager from the tls-session-manager package.
- Everything else as proposed by
makeClientParams
.
:: ServiceID |
Identification of the connection consisting of the fully qualified host name for the server (e.g. www.example.com) and an optional suffix. It is important that the hostname part is properly filled for security reasons, as it allow to properly associate the remote side with the given certificate during a handshake. The suffix is used to identity a certificate per service on a specific
host. For example, a same host might have different certificates on
differents ports (443 and 995). For TCP connections, it's recommended
to use: |
-> [Credential] | Credentials to provide to the server if requested. Only credentials
matching the server's Can be loaded with |
-> CertificateStore | CAs used to verify the server certificate. Use |
-> ClientParams |
Make defaults ClientParams
.
- Certificate chain validation is done by
validateDefault
from the Data.X509.Validation module. - The Server Name Indication (SNI) TLS extension is enabled.
- The supported cipher suites are those enumerated by
ciphersuite_default
, in decreasing order of preference. - Secure renegotiation is enabled.
- Only the TLS 1.1, TLS 1.2 and TLS 1.3 protocols are supported by default.
If you are unsatisfied with any of these settings, please
please refer to the Network.TLS module for more documentation on
ClientParams
.
Utils
send :: MonadIO m => Context -> ByteString -> m () Source #
Encrypts the given strict ByteString
and sends it through the
Context
.
sendLazy :: MonadIO m => Context -> ByteString -> m () Source #
Encrypts the given lazy ByteString
and sends it through the
Context
.
Low level support
useTls :: (MonadIO m, MonadMask m) => ((Context, SockAddr) -> m a) -> (Context, SockAddr) -> m a Source #
Perform a TLS handshake on the given Context
, then perform the
given action and at last gracefully close the TLS session using bye
.
This function does not close the underlying TCP connection when done.
Prefer to use useTlsThenClose
or useTlsThenCloseFork
if you need that
behavior. Otherwise, you must call contextClose
yourself at some point.
useTlsThenClose :: (MonadIO m, MonadMask m) => ((Context, SockAddr) -> m a) -> (Context, SockAddr) -> m a Source #
Like useTls
, except it also fully closes the TCP connection when done.
useTlsThenCloseFork :: MonadIO m => ((Context, SockAddr) -> IO ()) -> (Context, SockAddr) -> m ThreadId Source #
Similar to useTlsThenClose
, except it performs the all the IO actions
in a new thread.
Use this instead of forking useTlsThenClose
yourself, as that won't give
the right behavior.
:: MonadIO m | |
=> ClientParams | TLS settings. |
-> HostName | Server hostname. |
-> ServiceName | Server service name or port number. |
-> m (Context, SockAddr) |
Estalbishes a TCP connection to a remote server and returns a TLS
Context
configured on top of it using the given ClientParams
.
The remote end address is also returned.
Prefer to use connect
if you will be using the obtained Context
within a
limited scope.
You need to perform a TLS handshake on the resulting Context
before using
it for communication purposes, and gracefully close the TLS and TCP
connections afterwards using. The useTls
, useTlsThenClose
and
useTlsThenCloseFork
can help you with that.
:: MonadIO m | |
=> HostName | SOCKS5 proxy server hostname or IP address. |
-> ServiceName | SOCKS5 proxy server service port name or number. |
-> ClientParams | TLS settings. |
-> HostName | Destination server hostname or IP address. We connect to this host through the SOCKS5 proxy specified in the previous arguments. Note that if hostname resolution on this |
-> ServiceName | Destination server service port name or number. |
-> m (Context, SockAddr, SockAddr) | Returns the |
Like connectTls
, but connects to the destination server over a SOCKS5
proxy.
:: MonadIO m | |
=> ServerParams | TLS settings. |
-> Socket | Listening and bound socket. |
-> m (Context, SockAddr) |
Accepts an incoming TCP connection and returns a TLS Context
configured
on top of it using the given ServerParams
. The remote end address is also
returned.
Prefer to use accept
if you will be using the obtained Context
within a
limited scope.
You need to perform a TLS handshake on the resulting Context
before using
it for communication purposes, and gracefully close the TLS and TCP
connections afterwards using. The useTls
, useTlsThenClose
and
useTlsThenCloseFork
can help you with that.
makeClientContext :: MonadIO m => ClientParams -> Socket -> m Context Source #
makeServerContext :: MonadIO m => ServerParams -> Socket -> m Context Source #
Re-exports
For your convenience, this module module also re-exports the following types from other modules:
withSocketsDo :: IO a -> IO a #
With older versions of the network
library (version 2.6.0.2 or earlier)
on Windows operating systems,
the networking subsystem must be initialised using withSocketsDo
before
any networking operations can be used. eg.
main = withSocketsDo $ do {...}
It is fine to nest calls to withSocketsDo
, and to perform networking operations
after withSocketsDo
has returned.
withSocketsDo
is not necessary for the current network library.
However, for compatibility with older versions on Windows, it is good practice
to always call withSocketsDo
(it's very cheap).
data HostPreference #
Preferred host to bind.
HostAny | Any available host. |
HostIPv4 | Any available IPv4 host. |
HostIPv6 | Any available IPv6 host. |
Host HostName | An explicit host name. |
Instances
Either a host name e.g., "haskell.org"
or a numeric host
address string consisting of a dotted decimal IPv4 address or an
IPv6 address e.g., "192.168.0.1"
.
type ServiceName = String #
Either a service name e.g., "http"
or a numeric port number.
A service port like "80"
or its name "www"
.
Basic type for a socket.
Instances
Show Socket | |
Eq Socket | |
HasBackend Socket | |
Defined in Network.TLS.Backend initializeBackend :: Socket -> IO () # getBackend :: Socket -> Backend # |
Socket addresses.
The existence of a constructor does not necessarily imply that
that socket address type is supported on your system: see
isSupportedSockAddr
.
Instances
NFData SockAddr | |
Defined in Network.Socket.Types | |
Eq SockAddr | |
Ord SockAddr | |
Defined in Network.Socket.Types | |
SocketAddress SockAddr | |
Defined in Network.Socket.Types sizeOfSocketAddress :: SockAddr -> Int # peekSocketAddress :: Ptr SockAddr -> IO SockAddr # pokeSocketAddress :: Ptr a -> SockAddr -> IO () # |
data ClientParams #
Instances
Show ClientParams | |
Defined in Network.TLS.Parameters showsPrec :: Int -> ClientParams -> ShowS # show :: ClientParams -> String # showList :: [ClientParams] -> ShowS # | |
TLSParams ClientParams | |
Defined in Network.TLS.Context getTLSCommonParams :: ClientParams -> CommonParams getTLSRole :: ClientParams -> Role doHandshake :: ClientParams -> Context -> IO () doHandshakeWith :: ClientParams -> Context -> Handshake -> IO () doRequestCertificate :: ClientParams -> Context -> IO Bool doPostHandshakeAuthWith :: ClientParams -> Context -> Handshake13 -> IO () |
Please refer to the Network.TLS module for more documentation on
ClientParams
.
There's plenty to be changed, but the documentation for
ClientParams
is not rendered inside Network.Simple.TCP.TLS module.
data ServerParams #
Instances
Show ServerParams | |
Defined in Network.TLS.Parameters showsPrec :: Int -> ServerParams -> ShowS # show :: ServerParams -> String # showList :: [ServerParams] -> ShowS # | |
Default ServerParams | |
Defined in Network.TLS.Parameters def :: ServerParams # | |
TLSParams ServerParams | |
Defined in Network.TLS.Context getTLSCommonParams :: ServerParams -> CommonParams getTLSRole :: ServerParams -> Role doHandshake :: ServerParams -> Context -> IO () doHandshakeWith :: ServerParams -> Context -> Handshake -> IO () doRequestCertificate :: ServerParams -> Context -> IO Bool doPostHandshakeAuthWith :: ServerParams -> Context -> Handshake13 -> IO () |
Please refer to the Network.TLS module for more documentation on
ServerParams
.
There's plenty to be changed, but the documentation for
ServerParams
is not rendered inside Network.Simple.TCP.TLS module.
type Credential = (CertificateChain, PrivKey) #