| Copyright | (c) Phil Hargett 2013 |
|---|---|
| License | MIT (see LICENSE file) |
| Maintainer | phil@haphazardhouse.net |
| Stability | experimental |
| Portability | non-portable (requires STM) |
| Safe Haskell | None |
| Language | Haskell98 |
Network.Endpoints
Description
Endpoints are a generalized abstraction for communication between parts of a program,
whether on the same physical host or distributed over a network. Endpoints are intended
to simplify the development of network-centric applications by providing a small transport-independent
message-passing interface, and application writers can independently alter their implementation
by enabling their Endpoints with different Transports without modifying the logic of their
application that sends / receives Messages.
- data Endpoint = Endpoint {}
- newEndpoint :: IO Endpoint
- withName :: Endpoint -> Name -> IO a -> IO a
- bindName :: Endpoint -> Name -> STM ()
- unbindName :: Endpoint -> Name -> STM ()
- data BindException
- sendMessage :: Endpoint -> Name -> Message -> IO ()
- broadcastMessage :: Endpoint -> [Name] -> Message -> IO ()
- receiveMessage :: Endpoint -> IO Message
- receiveMessageTimeout :: Endpoint -> Int -> IO (Maybe Message)
- postMessage :: Endpoint -> Message -> STM ()
- selectMessage :: Endpoint -> (Message -> Maybe v) -> IO v
- selectMessageTimeout :: Endpoint -> Int -> (Message -> Maybe v) -> IO (Maybe v)
- detectMessage :: Endpoint -> (Message -> Maybe v) -> IO v
- detectMessageTimeout :: Endpoint -> Int -> (Message -> Maybe v) -> IO (Maybe v)
- data Envelope = Envelope {}
- type Message = ByteString
- newtype Name = Name String
How to use courier in an application
A sample of how to use this library:
module Main where
-- Import this package to manage endpoints
import Network.Endpoints
-- A specific transport is necessary, however
import Network.Transport.Sockets.TCP
-- Needed for serialization
import Data.Serialize
main :: IO ()
main = do
-- each endpoint needs a name; since we're using TCP
-- as our transport, they need to be host/port pairs
let name1 = Name "localhost:9001"
name2 = Name "localhost:9002"
-- the default resolvers just pull apart a name into separate
-- host and port components; more elaborate resolvers could
-- perform name lookups or other translations
resolver = tcpSocketResolver4
-- we need endpoints for each end of the communication
endpoint1 <- newEndpoint
endpoint2 <- newEndpoint
-- we need a transport to move messages between endpoints
withTransport (newTCPTransport4 resolver) $ \transport ->
withEndpoint transport endpoint1 $
withEndpoint transport endpoint2 $
-- the first endpoint is just a client, so it needs a name to receive
-- responses, but does not need a binding since it isn't accept connections
withName endpoint1 name1 $
-- the second endpoint is a server, so it needs a binding
withBinding transport endpoint2 name2 $
-- a connection between the first endpoint and the name of the second
-- creates a bi-directional path for messages to flow between the endpoints
withConnection transport endpoint1 name2 $ do
sendMessage endpoint1 name2 $ encode "hello world!"
msg <- receiveMessage endpoint2
let Right txt = decode msg
in print (txt :: String)
Primary API
Endpoints are a locus of communication, used for sending and receive messages.
Constructors
| Endpoint | |
Fields | |
withName :: Endpoint -> Name -> IO a -> IO a Source #
Declare an Endpoint as having the specified Name while the supplied function executes. This can
often be useful for establishing the Name of a client or initiator of a Connection,
without requiring the client also have a Binding.
bindName :: Endpoint -> Name -> STM () Source #
Establish Name as one of the boundEndpointNames for an Endpoint. Throws BindingExists if
the Endpoint is already bound to the Name.
unbindName :: Endpoint -> Name -> STM () Source #
Remove Name as one of the boundEndpointNames for an Endpoint. Throws BindingDoesNotExist
if the Endpoint is not bound to the Name.
receiveMessageTimeout :: Endpoint -> Int -> IO (Maybe Message) Source #
Wait for a message to be received within the timeout, blocking until either a message
is available or the timeout has occurred. If a message was available, returns Just message,
but returns Nothing if no message available before the timeout occurred.
Selective message reception
selectMessage :: Endpoint -> (Message -> Maybe v) -> IO v Source #
Select the next available message in the Endpoint Mailbox matching
the supplied test function, or blocking until one is available. This function
differs from receiveMessage in that it supports out of order message reception.
selectMessageTimeout :: Endpoint -> Int -> (Message -> Maybe v) -> IO (Maybe v) Source #
Wait for a message to be selected within the timeout, blocking until either a message
is available or the timeout has occurred. If a message was available, returns Just message,
but returns Nothing if no message available before the timeout occurred. Like
selectMessage, this function enables out of order message reception.
Other types
An Envelope wraps a Message with the Names of the destination for the message and (optionally)
the origin.
Constructors
| Envelope | |
Fields | |
type Message = ByteString Source #
Messages are containers for arbitrary data that may be sent to other Endpoints.