Hermes-0.0.3: Message-based middleware layerSource codeContentsIndex
Network.Hermes
Contents
Authorities
Context control
Listeners
Explicit connections
Messaging
Remote Procedure Calls
Gossip
Address book
Debugging
Description

Hermes is a middleware layer providing best-effort unicast, remote procedure calls, probabilistic (and slow!) broadcast and automatic membership management. It is meant for small-to-medium networks; its broadcast gossip protocol, which is used for membership management, will scale poorly to very large ones.

Hermes uses HsLogger for event logging, using the "hermes" namespace.

Synopsis
data HermesException
= HermesIDUnknown HermesID
| AddressUnknown HermesID
| DNSFailure Address
| WrongProtocol
| ProtocolVersionMismatch Word32 Word32
| AuthError String
| DeserializationError String
| ListenerAlreadyExists
| MessageError
| Timeout
| RecvCancelled
withHermes :: IO a -> IO a
data SignatureRequest
type Signature = ByteString
data Authority
newAuthority :: IO Authority
newSignatureRequest :: Context -> SignatureRequest
signRequest :: Authority -> SignatureRequest -> Signature
installSignature :: Context -> Signature -> IO ()
addAuthority :: Context -> Authority -> IO ()
data Context
data TrustLevel
= None
| Indirect
| Direct
type HermesID = Integer
newContext :: IO Context
newSignedContext :: Authority -> IO Context
snapshotContext :: Context -> IO ByteString
snapshotContext' :: Context -> STM ByteString
restoreContext :: ByteString -> IO Context
uuid :: Context -> HermesID
setTimeout :: Context -> Double -> IO ()
setTrustLimit :: Context -> TrustLevel -> IO ()
startListener :: Context -> Address -> Maybe Address -> IO ()
data Address
= IP HostName Int
| IPv4 HostName Int
| IPv6 HostName Int
| Unix FilePath
connect :: Context -> Address -> IO HermesID
send :: (Serialize msg, Typeable msg) => Context -> HermesID -> msg -> IO ()
send' :: (Serialize msg, Typeable msg, Serialize tag, Typeable tag) => Context -> HermesID -> msg -> tag -> IO ()
recv :: (Serialize msg, Typeable msg) => Context -> IO (HermesID, msg)
recv' :: (Serialize msg, Typeable msg, Serialize tag, Typeable tag) => Context -> tag -> IO (HermesID, msg)
acceptType :: forall tag msg. (Typeable msg, Serialize tag, Typeable tag) => Context -> msg -> tag -> IO ()
refuseType :: forall tag msg. (Typeable msg, Serialize tag, Typeable tag) => Context -> msg -> tag -> IO ()
call :: forall a b. (Serialize a, Typeable a, Serialize b, Typeable b) => Context -> HermesID -> ProcName -> a -> IO (Maybe b)
registerCallback :: forall a b. (Serialize a, Serialize b, Typeable a, Typeable b) => Context -> ProcName -> (a -> IO b) -> IO ()
type ProcName = String
writeFactoid :: forall factoid tag. (Typeable factoid, Serialize factoid, Typeable tag, Serialize tag) => Context -> factoid -> tag -> Maybe TTL -> IO ()
readFactoid :: forall factoid tag. (Typeable factoid, Serialize factoid, Typeable tag, Serialize tag) => Context -> tag -> HermesID -> IO (Maybe factoid)
readFactoids :: forall factoid tag. (Typeable factoid, Serialize factoid, Typeable tag, Serialize tag) => Context -> tag -> IO [(HermesID, factoid)]
addCallback :: forall msg tag. (Serialize tag, Typeable tag, Serialize msg, Typeable msg) => Context -> (HermesID -> tag -> msg -> IO ()) -> IO ()
setPeriod :: Context -> Double -> IO ()
type TTL = Double
snapshotAddresses :: Context -> STM ByteString
restoreAddresses :: Context -> ByteString -> STM (Maybe String)
setDebug :: Priority -> IO ()
data Priority
= DEBUG
| INFO
| NOTICE
| WARNING
| ERROR
| CRITICAL
| ALERT
| EMERGENCY
Documentation
data HermesException Source
Most Hermes functions can throw one of these exceptions, which | are mainly triggered when (re)negotiating connections.
Constructors
HermesIDUnknown HermesIDHermes has no idea who you're talking about. How did you even get the HermesID? HermesID information is never discarded, so this exception should be rather uncommon.
AddressUnknown HermesIDWe don't know where this HermesID is; we never did, or old information proved to be false.
DNSFailure AddressFailed to resolve the address
WrongProtocolThe remote server is not speaking Hermes-speak.
ProtocolVersionMismatch Word32 Word32A different protocol version is in use at the remote host. Check library version.
AuthError StringSomething went wrong while authenticating. Have a reason.
DeserializationError StringSomething went wrong while deserializing your data.
ListenerAlreadyExistsAttempted to create a listener on a port we're already listening to
MessageErrorMessage corrupted (connection broken)
TimeoutSome operation took longer than the user-configured timeout
RecvCancelledReceive was explicitly cancelled by the user
show/hide Instances
withHermes :: IO a -> IO aSource
All use of hermes must be wrapped with this (on windows)
Authorities

Unless you turn security off entirely, one Hermes node will not talk with another unless it trusts the other node. There are two ways to achieve this: You can specify trusted keys explicitly, or you can create an signature authority that can create trusted keys.

This section deals with the latter.

data SignatureRequest Source
show/hide Instances
type Signature = ByteStringSource
data Authority Source
show/hide Instances
newAuthority :: IO AuthoritySource
newSignatureRequest :: Context -> SignatureRequestSource
Creates a signature request for serialization
signRequest :: Authority -> SignatureRequest -> SignatureSource
Sign a request. Use setKeySignature to install it.
installSignature :: Context -> Signature -> IO ()Source
addAuthority :: Context -> Authority -> IO ()Source
Adds an authority to the list of trusted authorities
Context control
All communication requires a Hermes context. This section deals with creating, saving and loading them.
data Context Source
data TrustLevel Source

If Indirect, require a signature from an authority.

If Direct, require an OK from the library client.

If None, no trust is required.

Constructors
None
Indirect
Direct
show/hide Instances
type HermesID = IntegerSource
A hash computed from a public key
newContext :: IO ContextSource

Creates a new Hermes context allowing messaging, RPC and gossip, and using automatic address dissemination via the gossip protocol.

The trust level defaults to Indirect.

The gossip interval defaults to 300 seconds, call setPeriod to change it.

newSignedContext :: Authority -> IO ContextSource
Creates a pre-signed context. You may snapshot this to restore on another computer, or use on this one.
snapshotContext :: Context -> IO ByteStringSource
snapshotContext' :: Context -> STM ByteStringSource

Snapshots a context for storage

Transient state (RPC calls, messages) are discarded, as are connection, listener information and RPC bindings.

restoreContext :: ByteString -> IO ContextSource

Restores a context from storage

You will have to reset RPC bindings and listeners.

uuid :: Context -> HermesIDSource
setTimeoutSource
:: Context
-> DoubleDesired timeout, in seconds
-> IO ()
For operations that may block, other than recv, this sets a maximum wait time. Hermes will never block longer than this.
setTrustLimit :: Context -> TrustLevel -> IO ()Source

Set the desired trust limit, which will take effect on next connection

When connecting peers (either way), a degree of trust is required, or the connection will be rejected.

Listeners
startListenerSource
:: Context
-> AddressThe local address we should bind to
-> Maybe AddressAn address to provide peers; handy for firewalls.
-> IO ()
Set up a listener for incoming connections. These are not stored when snapshotting contexts. This function will return once the port has been bound.
data Address Source
Constructors
IP HostName IntHost name and port, IPv4, IPv6, or both
IPv4 HostName IntIPv4 only
IPv6 HostName IntIPv6 only
Unix FilePathUnix domain socket, not available on Windows
show/hide Instances
Explicit connections
While Hermes will normally maintain a membership list on its own, you still need the address of at least one node in order to download the list.
connect :: Context -> Address -> IO HermesIDSource

Connects to a given address without knowing in advance who will be answering. The answerer's HermesID is returned, assuming the connection is properly established.

Typically used for bootstrapping.

Messaging
send :: (Serialize msg, Typeable msg) => Context -> HermesID -> msg -> IO ()Source

Sends a message. The type representation is included, so a modicum of type safety is provided, and recv will only attempt to decode and return a message of the matching (not necessarily correct! Make sure your de/serializers match!) type. There is, of course, a possibility of exceptions if application versions differ.

You may use send' to provide an arbitrary tag to match on, in which case recv' will only return a message with an equal tag; if you don't, recv will only return messages without tags.

This function normally blocks until the entire message has been sent, an exception occurs or a timeout is reached. It will retry once if the connection fails within the timeout.

Unless acceptType or recv has been called in advance, sent messages are thrown away instead of queued. Once either has been, they are indefinitely queued until refuseType is called.

send' :: (Serialize msg, Typeable msg, Serialize tag, Typeable tag) => Context -> HermesID -> msg -> tag -> IO ()Source
recv :: (Serialize msg, Typeable msg) => Context -> IO (HermesID, msg)Source
Receives a message. This function blocks until a message of the appropriate type has been received, possibly forever. You may use multiple simultaneous recv calls; each message will only be delivered once.
recv' :: (Serialize msg, Typeable msg, Serialize tag, Typeable tag) => Context -> tag -> IO (HermesID, msg)Source
acceptTypeSource
:: forall tag msg . (Typeable msg, Serialize tag, Typeable tag)
=> Context
-> msgThe message type to accept. Only the type is used, so undefined is fine.
-> tag
-> IO ()

If you wish to queue messages without immediately calling recv, use this.

acceptType is idempotent.

refuseTypeSource
:: forall tag msg . (Typeable msg, Serialize tag, Typeable tag)
=> Context
-> msgThe message type to accept. Only the type is used, so undefined is fine.
-> tag
-> IO ()

If you wish to *stop* queueing messages of a given type, use this.

Calling refuseType will cause all recv calls to this type/tag combination to throw RecvCancelled.

refuseType is idempotent.

Remote Procedure Calls
call :: forall a b. (Serialize a, Typeable a, Serialize b, Typeable b) => Context -> HermesID -> ProcName -> a -> IO (Maybe b)Source

Remote procedure call

In addition to the usual core exceptions, this function may fail in the specific case the the named procedure doesn't exist or has the wrong type, in which case it returns Nothing.

registerCallbackSource
:: forall a b . (Serialize a, Serialize b, Typeable a, Typeable b)
=> Context
-> ProcNameCallback's name
-> a -> IO bThe callback itself
-> IO ()

Registers (or replaces) a callback that is to be executed whenever we receive a properly typed call to this name.

You may register calls with the same name, so long as they have different types.

If the callback already exists, it is overwritten.

type ProcName = StringSource
Gossip
writeFactoidSource
:: forall factoid tag . (Typeable factoid, Serialize factoid, Typeable tag, Serialize tag)
=> Context
-> factoid
-> tag
-> Maybe TTLThe timeout, in seconds
-> IO ()

Insert a factoid in the gossip network. This will immediately trigger a limited gossip exchange, hopefully spreading it to a large fraction of the network.

Factoids are keyed by their type, source, and the type and serialized value of an arbitrary tag. They can be replaced by re-inserting later, and optionally expire after a timeout.

Don't rely on the timeout, though. It's for garbage collection, and is not required to be exact.

readFactoid :: forall factoid tag. (Typeable factoid, Serialize factoid, Typeable tag, Serialize tag) => Context -> tag -> HermesID -> IO (Maybe factoid)Source
Read a factoid, assuming it exists.
readFactoids :: forall factoid tag. (Typeable factoid, Serialize factoid, Typeable tag, Serialize tag) => Context -> tag -> IO [(HermesID, factoid)]Source
Read all factoids with an appropriate type and tag. Useful if you don't know what source to expect.
addCallback :: forall msg tag. (Serialize tag, Typeable tag, Serialize msg, Typeable msg) => Context -> (HermesID -> tag -> msg -> IO ()) -> IO ()Source
Add a callback to be called every time a type-matching factoid is inserted or updated. It will not be called for writeFactoid calls.
setPeriodSource
:: Context
-> DoubleThe period, in seconds
-> IO ()
Set the period for the periodic gossiper. It will take effect after the next periodic gossip.
type TTL = DoubleSource
Seconds
Address book
snapshotAddresses :: Context -> STM ByteStringSource
The address snapshot contains address information for every node we know of, which can be restored into another node to bootstrap it.
restoreAddresses :: Context -> ByteString -> STM (Maybe String)Source

Restore an address snapshot to bootstrap your node.

Returns Nothing on success, otherwise a parse error.

Debugging
setDebug :: Priority -> IO ()Source
This utility function decides the lowest priority that will be shown. The default is WARNING.
data Priority Source

Priorities are used to define how important a log messgae is. Users can filter log messages based on priorities.

These have their roots on the traditional syslog system. The standard definitions are given below, but you are free to interpret them however you like. They are listed here in ascending importance order.

Constructors
DEBUGDebug messages
INFOInformation
NOTICENormal runtime conditions
WARNINGGeneral Warnings
ERRORGeneral Errors
CRITICALSevere situations
ALERTTake immediate action
EMERGENCYSystem is unusable
show/hide Instances
Produced by Haddock version 2.6.1