courier-0.1.1.4: A message-passing library for simplifying network applications

Copyright(c) Phil Hargett 2013
LicenseMIT (see LICENSE file)
Maintainerphil@haphazardhouse.net
Stabilityexperimental
Portabilitynon-portable (requires STM)
Safe HaskellNone
LanguageHaskell98

Network.Endpoints

Contents

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.

Synopsis

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

data Endpoint Source #

Endpoints are a locus of communication, used for sending and receive messages.

Constructors

Endpoint 

Fields

newEndpoint :: IO Endpoint Source #

Create a new Endpoint using the provided transports.

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.

sendMessage :: Endpoint -> Name -> Message -> IO () Source #

Send a Message to specific Name via the indicated Endpoint.

broadcastMessage :: Endpoint -> [Name] -> Message -> IO () Source #

Helper for sending a single Message to several Endpoints.

receiveMessage :: Endpoint -> IO Message Source #

Receive the next Message sent to the Endpoint, blocking until a message is available.

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.

postMessage :: Endpoint -> Message -> STM () Source #

Posts a Message directly to an Endpoint, without use of a transport. This may be useful for applications that prefer to use the Endpoint's Mailbox as a general queue of ordered messages.

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.

detectMessage :: Endpoint -> (Message -> Maybe v) -> IO v Source #

Find a Message in the Endpoint Mailbox matching the supplied test function, or block until one is available. Note that any such message is left in the mailbox, and thus repeated calls to this function could find the message if it is not consumed immediately.

detectMessageTimeout :: Endpoint -> Int -> (Message -> Maybe v) -> IO (Maybe v) Source #

Find a Message in the Endpoint Mailbox matching the supplied test function, or block until either one is available or the timeout expires. Note that any such message is left in the mailbox, and thus repeated calls to this function could find the message if it is not consumed immediately.

Other types

data Envelope Source #

An Envelope wraps a Message with the Names of the destination for the message and (optionally) the origin.

type Message = ByteString Source #

Messages are containers for arbitrary data that may be sent to other Endpoints.

newtype Name Source #

Name for uniquely identifying an Endpoint; suitable for identifying the target destination for a Message. The specific interpretation of a name is left to each Transport

Constructors

Name String 

Instances

Eq Name Source # 

Methods

(==) :: Name -> Name -> Bool #

(/=) :: Name -> Name -> Bool #

Ord Name Source # 

Methods

compare :: Name -> Name -> Ordering #

(<) :: Name -> Name -> Bool #

(<=) :: Name -> Name -> Bool #

(>) :: Name -> Name -> Bool #

(>=) :: Name -> Name -> Bool #

max :: Name -> Name -> Name #

min :: Name -> Name -> Name #

Show Name Source # 

Methods

showsPrec :: Int -> Name -> ShowS #

show :: Name -> String #

showList :: [Name] -> ShowS #

Generic Name Source # 

Associated Types

type Rep Name :: * -> * #

Methods

from :: Name -> Rep Name x #

to :: Rep Name x -> Name #

Serialize Name Source # 

Methods

put :: Putter Name #

get :: Get Name #

type Rep Name Source # 
type Rep Name = D1 (MetaData "Name" "Network.Endpoints" "courier-0.1.1.4-8VnANyX6BNvHCPcghPXNFF" True) (C1 (MetaCons "Name" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 String)))