sockets-0.3.1.0: High-level network sockets

Safe HaskellNone
LanguageHaskell2010

Socket.Stream.IPv4

Contents

Synopsis

Types

data Listener Source #

A socket that listens for incomming connections.

data Connection Source #

A connection-oriented stream socket.

data Endpoint Source #

An endpoint for an IPv4 socket, connection, or listener. Everything is in host byte order, and the user is not responisble for performing any conversions.

Constructors

Endpoint 

Fields

Instances
Eq Endpoint Source # 
Instance details

Defined in Socket.IPv4

Show Endpoint Source # 
Instance details

Defined in Socket.IPv4

Bracketed

withAccepted Source #

Arguments

:: Listener 
-> (Either CloseException () -> a -> IO b)

Callback to handle an ungraceful close.

-> (Connection -> Endpoint -> IO a)

Callback to consume connection. Must not return the connection.

-> IO (Either (AcceptException Uninterruptible) b) 

Accept a connection on the listener and run the supplied callback on it. This closes the connection when the callback finishes or if an exception is thrown. Since this function blocks the thread until the callback finishes, it is only suitable for stream socket clients that handle one connection at a time. The variant forkAcceptedUnmasked is preferrable for servers that need to handle connections concurrently (most use cases).

withConnection Source #

Arguments

:: Endpoint

Remote endpoint

-> (Either CloseException () -> a -> IO b)

Callback to handle an ungraceful close.

-> (Connection -> IO a)

Callback to consume connection. Must not return the connection.

-> IO (Either (ConnectException Uninterruptible) b) 

Establish a connection to a server.

interruptibleWithConnection Source #

Arguments

:: TVar Bool

Interrupted. If this becomes True, give up and return Left AcceptInterrupted.

-> Endpoint

Remote endpoint

-> (Either CloseException () -> a -> IO b)

Callback to handle an ungraceful close.

-> (Connection -> IO a)

Callback to consume connection. Must not return the connection.

-> IO (Either (ConnectException Interruptible) b) 

forkAccepted Source #

Arguments

:: Listener 
-> (Either CloseException () -> a -> IO ())

Callback to handle an ungraceful close.

-> (Connection -> Endpoint -> IO a)

Callback to consume connection. Must not return the connection.

-> IO (Either (AcceptException Uninterruptible) ThreadId) 

Accept a connection on the listener and run the supplied callback in a new thread. Prefer forkAcceptedUnmasked unless the masking state needs to be preserved for the callback. Such a situation seems unlikely to the author.

forkAcceptedUnmasked Source #

Arguments

:: Listener 
-> (Either CloseException () -> a -> IO ())

Callback to handle an ungraceful close.

-> (Connection -> Endpoint -> IO a)

Callback to consume connection. Must not return the connection.

-> IO (Either (AcceptException Uninterruptible) ThreadId) 

Accept a connection on the listener and run the supplied callback in a new thread. The masking state is set to Unmasked when running the callback. Typically, a is instantiated to ().

interruptibleForkAcceptedUnmasked Source #

Arguments

:: TVar Int

Connection counter. Incremented when connection is accepted. Decremented after connection is closed.

-> TVar Bool

Interrupted. If this becomes True give up and return Left AcceptInterrupted.

-> Listener

Connection listener

-> (Either CloseException () -> a -> IO ())

Callback to handle an ungraceful close.

-> (Connection -> Endpoint -> IO a)

Callback to consume connection. Must not return the connection.

-> IO (Either (AcceptException Interruptible) ThreadId) 

Accept a connection on the listener and run the supplied callback in a new thread. The masking state is set to Unmasked when running the callback. Typically, a is instantiated to ().

Discussion

Expand

Why is the counter argument present? At first, it seems like this is something that the API consumer should implement on top of this library. The argument for the inclusion of the counter is has two parts: (1) clients supporting graceful termination always need these semantics and (2) these semantics cannot be provided without building in counter as a TVar.

  1. Clients supporting graceful termination always need these semantics. To gracefully bring down a server that has been accepting connections with a forking function, an application must wait for all active connections to finish. Since all connections run on separate threads, this can only be accomplished by a concurrency primitive. The straightforward solution is to wrap a counter with either MVar or TVar. To complete graceful termination, the application must block until the counter reaches zero.
  2. These semantics cannot be provided without building in counter as a TVar. When abandon becomes True, graceful termination begins. From this point onward, if at any point the counter reaches zero, the application consuming this API will complete termination. Consequently, we need the guarantee that the counter does not increment after the abandon transaction completes. If it did increment in this forbidden way (e.g. if it was incremented some unspecified amount of time after a connection was accepted), there would be a race condition in which the application may terminate without giving the newly accepted connection a chance to finish. Fortunately, STM gives us the composable transaction we need to get this guarantee. To wait for an inbound connection, we use:
(isReady,deregister) <- threadWaitReadSTM fd
shouldReceive <- atomically $ do
  readTVar abandon >>= \case
    True -> do
      isReady
      modifyTVar' counter (+1)
      pure True
    False -> pure False

This eliminates the window for the race condition. If a connection is accepted, the counter is guaranteed to be incremented _before_ abandon becomes True. However, this code would be more simple and would perform better if GHC's event manager used TVar instead of STM.

Communicate

sendByteArraySlice Source #

Arguments

:: Connection

Connection

-> ByteArray

Payload (will be sliced)

-> Int

Offset into payload

-> Int

Length of slice into buffer

-> IO (Either (SendException Uninterruptible) ()) 

sendMutableByteArray Source #

Arguments

:: Connection

Connection

-> MutableByteArray RealWorld

Buffer (will be sliced)

-> IO (Either (SendException Uninterruptible) ()) 

sendMutableByteArraySlice Source #

Arguments

:: Connection

Connection

-> MutableByteArray RealWorld

Buffer (will be sliced)

-> Int

Offset into payload

-> Int

Length of slice into buffer

-> IO (Either (SendException Uninterruptible) ()) 

sendAddr Source #

Arguments

:: Connection

Connection

-> Addr

Payload start address

-> Int

Payload length

-> IO (Either (SendException Uninterruptible) ()) 

sendByteString Source #

Arguments

:: Connection

Connection

-> ByteString

Payload

-> IO (Either (SendException Uninterruptible) ()) 

Send a ByteString over a connection.

sendLazyByteString Source #

Arguments

:: Connection

Connection

-> ByteString

Payload

-> IO (Either (SendException Uninterruptible) ()) 

Send a lazy ByteString over a connection.

interruptibleSendByteArray Source #

Arguments

:: TVar Bool

Interrupted. If this becomes True, give up and return Left AcceptInterrupted.

-> Connection

Connection

-> ByteArray

Payload

-> IO (Either (SendException Interruptible) ()) 

interruptibleSendByteArraySlice Source #

Arguments

:: TVar Bool

Interrupted. If this becomes True, give up and return Left AcceptInterrupted.

-> Connection

Connection

-> ByteArray

Payload (will be sliced)

-> Int

Offset into payload

-> Int

Length of slice into buffer

-> IO (Either (SendException Interruptible) ()) 

interruptibleSendMutableByteArraySlice Source #

Arguments

:: TVar Bool

Interrupted. If this becomes True give up and return Left AcceptInterrupted.

-> Connection

Connection

-> MutableByteArray RealWorld

Buffer (will be sliced)

-> Int

Offset into payload

-> Int

Length of slice into buffer

-> IO (Either (SendException Interruptible) ()) 

receiveByteArray Source #

Arguments

:: Connection

Connection

-> Int

Number of bytes to receive

-> IO (Either (ReceiveException Uninterruptible) ByteArray) 

Receive exactly the given number of bytes. If the remote application shuts down its end of the connection before sending the required number of bytes, this returns Left ReceiveShutdown.

receiveBoundedByteArray Source #

Arguments

:: Connection

Connection

-> Int

Maximum number of bytes to receive

-> IO (Either (ReceiveException Uninterruptible) ByteArray) 

Receive up to the given number of bytes. If the remote application shuts down its end of the connection instead of sending any bytes, this returns Left (SocketException Receive RemoteShutdown).

receiveBoundedMutableByteArraySlice Source #

Arguments

:: Connection

Connection

-> Int

Maximum number of bytes to receive

-> MutableByteArray RealWorld

Buffer in which the data are going to be stored

-> Int

Offset in the buffer

-> IO (Either (ReceiveException Uninterruptible) Int)

Either a socket exception or the number of bytes read

Receive up to the given number of bytes, using the given array and starting at the given offset.

receiveMutableByteArray :: Connection -> MutableByteArray RealWorld -> IO (Either (ReceiveException Uninterruptible) ()) Source #

Receive a number of bytes exactly equal to the size of the mutable byte array. If the remote application shuts down its end of the connection before sending the required number of bytes, this returns Left (SocketException Receive RemoteShutdown).

receiveByteString Source #

Arguments

:: Connection

Connection

-> Int

Number of bytes to receive

-> IO (Either (ReceiveException Uninterruptible) ByteString) 

Receive exactly the given number of bytes.

interruptibleReceiveByteArray Source #

Arguments

:: TVar Bool

Interrupted. If this becomes True give up and return Left ReceiveInterrupted.

-> Connection

Connection

-> Int

Number of bytes to receive

-> IO (Either (ReceiveException Interruptible) ByteArray) 

Variant of receiveByteArray that support STM-style interrupts.

interruptibleReceiveBoundedMutableByteArraySlice Source #

Arguments

:: TVar Bool

Interrupted. If this becomes True give up and return Left ReceiveInterrupted.

-> Connection

Connection

-> Int

Maximum number of bytes to receive

-> MutableByteArray RealWorld

Buffer in which the data are going to be stored

-> Int

Offset in the buffer

-> IO (Either (ReceiveException Interruptible) Int)

Either a socket exception or the number of bytes read

Receive up to the given number of bytes, using the given array and starting at the given offset. This can be interrupted by the completion of an STM transaction.

Exceptions

data SendException :: Interruptibility -> Type where Source #

Constructors

SendShutdown :: SendException i

The local socket has already shutdown its writing channel. Consequently, sending is no longer possible. This can happen even if the process does not shutdown the socket. If the peer decides to close the connection, the local operating system will shutdown both the reading and writing channels. (EPIPE)

SendReset :: SendException i

The peer reset the connection.

SendInterrupted :: SendException Interruptible

STM-style interrupt (much safer than C-style interrupt)

data ReceiveException :: Interruptibility -> Type where Source #

Recoverable exceptions that can occur while receiving data on a stream socket.

Discussion

Expand

The recv man page explicitly documents these:

  • EAGAIN/EAGAIN: Not possible after using event manager to wait.
  • EBADF: Prevented by this library.
  • ECONNREFUSED: Not sure if this is possible. Currently treated as an unrecoverable exception.
  • EFAULT: Not recoverable. API consumer has misused Addr.
  • EINTR: Prevented by this library. Unsafe FFI is not interruptible.
  • EINVAL: Prevented by this library.
  • ENOMEM: Not recoverable.
  • ENOTCONN: Prevented by this library.
  • ENOTSOCK: Prevented by this library.

The man page includes a disclaimer: "Additional errors may be generated and returned from the underlying protocol modules". One such error when dealing with stream sockets in ECONNRESET. One scenario where this happens is when the process running on the peer terminates ungracefully and the operating system on the peer cleans up by sending a reset.

Constructors

ReceiveShutdown :: ReceiveException i

The peer shutdown its writing channel. (zero-length chunk)

ReceiveReset :: ReceiveException i

The peer reset the connection. (ECONNRESET)

ReceiveInterrupted :: ReceiveException Interruptible

STM-style interrupt (much safer than C-style interrupt)

data ConnectException :: Interruptibility -> Type where Source #

Recoverable exceptions that can occur while connecting to a peer. This includes both failures while opening the socket and failures while connecting to the peer.

Discussion

Expand

In its API for connecting to a peer, this library combines the step of creating a socket with the step of connecting to the peer. In other words, the end user never gets access to an unconnected stream socket. Consequently, the connection exceptions correspond to the socket errors EMFILE and ENFILE as well as the connect errors ECONNREFUSED, EACCES/EPERM, ETIMEDOUT, ENETUNREACH, and EADDRNOTAVAIL.

Somewhat surprisingly, EADDRINUSE is not included in the list of connect error codes we recognize as recoverable. The accept man page describes EADDRINUSE as "Local address is already in use". However, it is unclear what this means. The caller of connect does not provide an internet socket address. If ephemeral ports are exhausted, connect will error with EADDRNOTAVAIL. An unresolved Stack Overflow question calls into question whether or not it is actually possible for this error to happen with an internet domain socket. The author has decided to omit any checks for it. This means that, if it does ever happen, it will cause a SocketUnrecoverableException to be thrown. The Linux cognoscenti are encouraged to open an issue if they have more information about the circumstances under which this exception can occur.

Constructors

ConnectFirewalled :: ConnectException i

Either the connection was blocked by a local firewall rule or it was blocked because it was to a broadcast address. Sadly, these two errors are not distinguished by the Linux sockets API. (EACCES/EPERM)

ConnectFileDescriptorLimit :: ConnectException i

A limit on the number of open file descriptors has been reached. This could be the per-process limit or the system limit. (EMFILE and ENFILE)

ConnectNetworkUnreachable :: ConnectException i

The network is unreachable. (ENETUNREACH)

ConnectEphemeralPortsExhausted :: ConnectException i

All port numbers in the ephemeral port range are currently in use. (EADDRNOTAVAIL)

ConnectRefused :: ConnectException i

No one is listening on the remote address. (ECONNREFUSED)

ConnectTimeout :: ConnectException i

Timeout while attempting connection. The server may be too busy to accept new connections. Note that stock Linux configuration has timeout at appropriately 20 seconds. Users interested in timing out more quickly are encouraged to use registerDelay with the interruptible variants of the connection functions in this library. (ETIMEDOUT)

ConnectInterrupted :: ConnectException Interruptible

STM-style interrupt (much safer than C-style interrupt)

data SocketException :: Type where Source #

Recoverable exceptions that happen when establishing an internet-domain stream listener or datagram socket.

Discussion

Expand

The recoverable exceptions that we from stream sockets (established with socket-bind-listen) and datagram sockets (established with socket-bind) are the exact same exceptions. Consequently, we reuse the same type in both case. It is a little unfortunate since the name ListenException would be more appropriate for stream sockets. But the code reuse is worth the naming quibble.

Constructors

SocketPermissionDenied :: SocketException

The address is protected, and the user is not the superuser. This most commonly happens when trying to bind to a port below 1024. On Linux, When it is necessary to bind to such a port on Linux, consider using the CAP_NET_BIND_SERVICE capability instead of running the process as root. (EACCES)

SocketAddressInUse :: SocketException

The given address is already in use. (EADDRINUSE with specified port)

SocketEphemeralPortsExhausted :: SocketException

The port number was specified as zero, but upon attempting to bind to an ephemeral port, it was determined that all port numbers numbers in the ephemeral port range are currently in use. (EADDRINUSE with unspecified port)

SocketFileDescriptorLimit :: SocketException

A limit on the number of open file descriptors has been reached. This could be the per-process limit or the system limit. (EMFILE and ENFILE)

data AcceptException :: Interruptibility -> Type where Source #

Recoverable exceptions that can occur while accepting an inbound connection.

Constructors

AcceptConnectionAborted :: AcceptException i

The peer reset the connection before the running process accepted it. This is not typically treated as fatal. The process may continue accepting connections. (ECONNABORTED)

AcceptFileDescriptorLimit :: AcceptException i

A limit on the number of open file descriptors has been reached. This could be the per-process limit or the system limit. (EMFILE and ENFILE)

AcceptFirewalled :: AcceptException i

Firewall rules forbid connection. (EPERM)

AcceptInterrupted :: AcceptException Interruptible

STM-style interrupt (much safer than C-style interrupt)

data CloseException :: Type where Source #

Constructors

ClosePeerContinuedSending :: CloseException

After the local process shut down the writing channel, it was expecting the peer to do the same. However, the peer sent more data instead. If this happens, the local process does still close the socket. However, it must send a TCP reset to accomplish this since there is still unread data in the receive buffer.

This can happen if the peer is misbehaving or if the consumer of the sockets API has incorrectly implemented a protocol living above layer 4 of the OSI model.

Unbracketed

Provided here are the unbracketed functions for the creation and destruction of listeners, outbound connections, and inbound connections. These functions come with pretty serious requirements:

  • They may only be called in contexts where exceptions are masked.
  • The caller must be sure to call the destruction function every Listener or Connection exactly once to close underlying file descriptor.
  • The Listener or Connection cannot be used after being given as an argument to the destruction function.

listen :: Endpoint -> IO (Either SocketException (Listener, Word16)) Source #

Open a socket that can be used to listen for inbound connections. Requirements:

  • This function may only be called in contexts where exceptions are masked.
  • The caller must be sure to call unlistener on the resulting Listener exactly once to close underlying file descriptor.
  • The Listener cannot be used after being given as an argument to unlistener.

Noncompliant use of this function leads to undefined behavior. Prefer withListener unless you are writing an integration with a resource-management library.

unlisten :: Listener -> IO () Source #

Close a listener. This throws an unrecoverable exception if the socket cannot be closed.

unlisten_ :: Listener -> IO () Source #

Close a listener. This does not check to see whether or not the operating system successfully closed the socket. It never throws exceptions of any kind. This should only be preferred to unlistener in exception-cleanup contexts where there is already an exception that will be rethrown. See the implementation of withListener for an example of appropriate use of both unlistener and unlistener_.

connect Source #

Arguments

:: Endpoint

Remote endpoint

-> IO (Either (ConnectException Uninterruptible) Connection) 

Open a socket and connect to a peer. Requirements:

Noncompliant use of this function leads to undefined behavior. Prefer withConnection unless you are writing an integration with a resource-management library.

interruptibleConnect Source #

Arguments

:: TVar Bool

Interrupted. If this becomes True, give up and return Left AcceptInterrupted.

-> Endpoint

Remote endpoint

-> IO (Either (ConnectException Interruptible) Connection) 

Variant of connect that is interruptible using STM-style interrupts.

disconnect :: Connection -> IO (Either CloseException ()) Source #

Close a connection gracefully, reporting a CloseException when the connection has to be terminated by sending a TCP reset. This uses a combination of shutdown, recv, close to detect when resets need to be sent.

disconnect_ :: Connection -> IO () Source #

Close a connection. This does not check to see whether or not the connection was brought down gracefully. It just calls close and is likely to cause a TCP reset to be sent. It never throws exceptions of any kind (even if close fails). This should only be preferred to disconnect in exception-cleanup contexts where there is already an exception that will be rethrown. See the implementation of withConnection for an example of appropriate use of both disconnect and disconnect_.

accept :: Listener -> IO (Either (AcceptException Uninterruptible) (Connection, Endpoint)) Source #

Listen for an inbound connection.

interruptibleAccept Source #

Arguments

:: TVar Bool

Interrupted. If this becomes True give up and return Left AcceptInterrupted.

-> Listener 
-> IO (Either (AcceptException Interruptible) (Connection, Endpoint)) 

Listen for an inbound connection. Can be interrupted by an STM-style interrupt.