Network.EventSocket
Contents
Description
This module provides an interface for the FreeSwitch event socket - http://wiki.freeswitch.org/wiki/Event_Socket.
Developed by David Austin (mailto:vulpyne+haskelleventsocket@teliax.com)
Released to the Open Source Software community by Teliax Inc (http://www.teliax.com/)
- data EventSocketMessage = EventSocketMessage {}
- data EventSocketIO h => EventSocketState h m
- data EventType
- = E_Start
- | E_End
- | E_Other ByteString
- | E_APIResponse
- | E_CommandReply
- | E_CHANNEL_CREATE
- | E_CHANNEL_DESTROY
- | E_CHANNEL_STATE
- | E_CHANNEL_ANSWER
- | E_CHANNEL_HANGUP
- | E_CHANNEL_HANGUP_COMPLETE
- | E_CHANNEL_EXECUTE
- | E_CHANNEL_EXECUTE_COMPLETE
- | E_CHANNEL_BRIDGE
- | E_CHANNEL_UNBRIDGE
- | E_CHANNEL_PROGRESS
- | E_CHANNEL_PROGRESS_MEDIA
- | E_CHANNEL_OUTGOING
- | E_CHANNEL_PARK
- | E_CHANNEL_UNPARK
- | E_CHANNEL_APPLICATION
- | E_CHANNEL_ORIGINATE
- | E_CHANNEL_UUID
- | E_SHUTDOWN
- | E_MODULE_LOAD
- | E_MODULE_UNLOAD
- | E_RELOADXML
- | E_NOTIFY
- | E_SEND_MESSAGE
- | E_RECV_MESSAGE
- | E_REQUEST_PARMS
- | E_CHANNEL_DATA
- | E_GENERAL
- | E_COMMAND
- | E_SESSION_HEARTBEAT
- | E_CLIENT_DISCONNECTED
- | E_SERVER_DISCONNECTED
- | E_SEND_INFO
- | E_RECV_INFO
- | E_CALL_SECURE
- | E_NAT
- | E_RECORD_START
- | E_RECORD_STOP
- | E_CALL_UPDATE
- | E_API
- | E_BACKGROUND_JOB
- | E_CUSTOM
- | E_RE_SCHEDULE
- | E_HEARTBEAT
- | E_DETECTED_TONE
- | E_ALL
- | E_LOG
- | E_INBOUND_CHAN
- | E_OUTBOUND_CHAN
- | E_STARTUP
- | E_PUBLISH
- | E_UNPUBLISH
- | E_TALK
- | E_NOTALK
- | E_SESSION_CRASH
- | E_DTMF
- | E_MESSAGE
- | E_PRESENCE_IN
- | E_PRESENCE_OUT
- | E_PRESENCE_PROBE
- | E_MESSAGE_WAITING
- | E_MESSAGE_QUERY
- | E_ROSTER
- | E_CODEC
- | E_DETECTED_SPEECH
- | E_PRIVATE_COMMAND
- | E_TRAP
- | E_ADD_SCHEDULE
- | E_DEL_SCHEDULE
- | E_EXE_SCHEDULE
- data EventSocketError
- data EventSocketCommand
- = CmdEvents {
- format :: ByteString
- events :: [ByteString]
- | CmdFilter { }
- | CmdLinger
- | CmdSet {
- key :: ByteString
- val :: ByteString
- | CmdHangup {
- reason :: ByteString
- | CmdSleep { }
- | CmdAnswer
- | CmdPlayGather {
- minDigits :: Int
- maxDigits :: Int
- tries :: Int
- timeout :: Int
- terminators :: ByteString
- file :: ByteString
- invalidFile :: ByteString
- varName :: ByteString
- regexp :: ByteString
- | CmdBridge {
- destinations :: [ByteString]
- | CmdSay {
- text :: ByteString
- | CmdSpeak {
- text :: ByteString
- | CmdPlay { }
- | CmdRecord {
- filename :: ByteString
- maxLength :: Int
- | CmdMetaApp { }
- | CmdSync
- = CmdEvents {
- data EventSocketIO h => SessionState h m
- type EvtKVMap = Map ByteString ByteString
- type ESUUID = ByteString
- data (Monad m, EventSocketIO h) => EventSocketT h m a
- class EventSocketIO h where
- esioBReadLine :: h -> IO ByteString
- esioBRead :: h -> Int -> IO ByteString
- esioBWrite :: h -> ByteString -> IO ()
- esioFlush :: h -> IO ()
- esioReady :: h -> IO Bool
- startEventSocket :: HostName -> PortNumber -> (EventSocketState Handle m -> IO ()) -> IO ()
- connectInbound :: (MonadIO m, EventSocketIO h) => EventSocketT h m EventSocketMessage
- runEventSocketT :: (MonadIO m, EventSocketIO h) => EventSocketT h m a -> EventSocketState h m -> m (Either EventSocketError a, EventSocketState h m)
- modifySyncMode :: (Monad m, EventSocketIO h) => (Bool -> Bool) -> EventSocketT h m Bool
- modifyDebugLevel :: (Monad m, EventSocketIO h) => (Int -> Int) -> EventSocketT h m Int
- registerEventHandler :: (MonadIO m, EventSocketIO h) => ByteString -> EventType -> Int -> EventHandlerFunc h m -> EventSocketT h m EventId
- unregisterEventHandler :: (Monad m, EventSocketIO h) => EventId -> EventSocketT h m ()
- type EventId = (Int, ByteString, EventType)
- data EventHandlerResult
- data EventSocketIO h => EventHandlerFunc h m = EventHandlerFunc (EventSocketMessage -> EventSocketT h m (Maybe (EventHandlerFunc h m), EventHandlerResult))
- syncPoint :: (MonadIO m, EventSocketIO h) => EventSocketT h m [EventSocketMessage]
- esRun :: (MonadIO m, EventSocketIO h) => EventSocketCommand -> EventSocketT h m [EventSocketMessage]
- esRunActions :: (MonadIO m, EventSocketIO h) => [EventSocketCommand] -> EventSocketT h m [EventSocketMessage]
- getSession :: (MonadIO m, EventSocketIO h) => ESUUID -> EventSocketT h m (Maybe (SessionState h m))
- apiAndReply :: (MonadIO m, EventSocketIO h) => ByteString -> ByteString -> EventSocketT h m [EventSocketMessage]
- commandAndReply :: (MonadIO m, EventSocketIO h) => ByteString -> ByteString -> EventSocketT h m [EventSocketMessage]
- withUUID :: (Monad m, EventSocketIO h) => ByteString -> EventSocketT h m a -> EventSocketT h m a
- getUUID :: (MonadIO m, EventSocketIO h) => EventSocketT h m ESUUID
- sendAPI :: (MonadIO m, EventSocketIO h) => ByteString -> ByteString -> EventSocketT h m ()
- sendCommand :: (MonadIO m, EventSocketIO h) => ByteString -> ByteString -> EventSocketT h m ()
- waitForEvent :: (MonadIO m, EventSocketIO h) => EventType -> EventSocketT h m [EventSocketMessage]
- eventSocketReadEventsUntil :: (MonadIO m, EventSocketIO h) => (Maybe EventSocketMessage -> EventSocketT h m Bool) -> EventSocketT h m (Bool, [EventSocketMessage])
- newEventSocketState :: EventSocketIO h => h -> HostName -> PortNumber -> EventSocketState h m
Types
Messages
data EventSocketMessage Source
Basically, an event. Used and returned by some of the lower level Eventsocket routines.
Constructors
EventSocketMessage | |
Fields
|
Base types
data EventSocketIO h => EventSocketState h m Source
The state of the event socket connection.
Instances
(Show h, EventSocketIO h) => Show (EventSocketState h m) | |
Monad m => MonadState (EventSocketState h m) (EventSocketT h m) |
Mainly FreeSwitch events.
More information for FreeSwitch-specific events: http://wiki.freeswitch.org/wiki/Event_list
Constructors
data EventSocketError Source
Error type thrown when something goes boom.
Constructors
UnknownError | |
NetworkError String | |
ParseError String | |
ProtocolError String | |
GeneralError String |
Instances
data EventSocketCommand Source
Event Socket commands. This list is far from complete.
More information is available: http://wiki.freeswitch.org/wiki/Command_reference
Constructors
Instances
data EventSocketIO h => SessionState h m Source
Stores a session. Two user accessible fields exist:
Instances
EventSocketIO h => Show (SessionState h m) |
type EvtKVMap = Map ByteString ByteStringSource
Just a simple map ByteString to ByteString.
type ESUUID = ByteStringSource
UUIDs are currently just bytestrings.
data (Monad m, EventSocketIO h) => EventSocketT h m a Source
Instances
Monad m => MonadError EventSocketError (EventSocketT h m) | |
EventSocketIO h => MonadTrans (EventSocketT h) | |
Monad m => Monad (EventSocketT h m) | |
(Monad m, EventSocketIO h) => Functor (EventSocketT h m) | |
(Monad m, EventSocketIO h) => Applicative (EventSocketT h m) | |
MonadIO m => MonadIO (EventSocketT h m) | |
Monad m => MonadState (EventSocketState h m) (EventSocketT h m) |
class EventSocketIO h whereSource
You may instance this class if you'd like to use a different handle type (or just read/write to the normal Handle in some special way.)
Methods
Arguments
:: h | |
-> IO ByteString | Read one line from the handle. |
Arguments
:: h | |
-> Int | |
-> IO ByteString | Read a specified amount of bytes from the handle. |
Arguments
:: h | |
-> ByteString | |
-> IO () | Write to the handle |
Instances
EventSocketIO Handle | There exists a default instance for Handle. |
Classes
Provided functions
Utility functions
Arguments
:: HostName | Hostname to listen on. |
-> PortNumber | Port number to listen on. |
-> (EventSocketState Handle m -> IO ()) | Action to run on each incoming connection. |
-> IO () |
Starts a listen socket for incoming EventSocket connections. You'll generally want to call connectInbound
after the handler is triggered.
connectInbound :: (MonadIO m, EventSocketIO h) => EventSocketT h m EventSocketMessageSource
Sends the initial connect message and receives a response.
Arguments
:: (MonadIO m, EventSocketIO h) | |
=> EventSocketT h m a | Monadic action to run. |
-> EventSocketState h m | Initial state (possibly from |
-> m (Either EventSocketError a, EventSocketState h m) | Returns a tuple with either the final result or error, and the ending state. |
Runs the event socket monad transformer.
Settings modification
modifySyncMode :: (Monad m, EventSocketIO h) => (Bool -> Bool) -> EventSocketT h m BoolSource
SyncMode controls whether Event-Lock: true is sent with commands.
modifyDebugLevel :: (Monad m, EventSocketIO h) => (Int -> Int) -> EventSocketT h m IntSource
Modifies the debug level. At high values, the event socket library will spit out massive amounts of data to the console.
Events
Arguments
:: (MonadIO m, EventSocketIO h) | |
=> ByteString | UUID for event handler, blank for globalr. |
-> EventType | Type of event to trigger on. |
-> Int | Priority, with lower events processed earlier. |
-> EventHandlerFunc h m | Event handler. |
-> EventSocketT h m EventId | Returns new Event ID. |
Registers an event handler. If the UUID is left blank, it will trigger globally on all events of the appropriate type.
Some event types (example E_CommandReply, E_APIResponse) do not have a UUID and therefore must be added as an global event if you wish to catch it.
Since the event may return a new handler function on each invocation, an event handler may maintain private state this way.
The event handler may return EHContinue to continue processing, EHStopEvents to stop processing events for that message or EHStopReading to exit the event reading loop entirely.
Event handlers are only called from within eventSocketReadEventsUntil
(and functions that use this: waitForEvent
, commandAndReply
, apiAndReply
).
Global events are processed first, then session events.
You may not recurse into eventSocketReadEventUntil
from within an event handler.
Arguments
:: (Monad m, EventSocketIO h) | |
=> EventId | Event ID to unregister. |
-> EventSocketT h m () |
Given an event ID, it will remove that event if it exists.
type EventId = (Int, ByteString, EventType)Source
data EventSocketIO h => EventHandlerFunc h m Source
Constructors
EventHandlerFunc (EventSocketMessage -> EventSocketT h m (Maybe (EventHandlerFunc h m), EventHandlerResult)) |
Instances
Show (EventHandlerFunc h m) |
Highlevel functions
syncPoint :: (MonadIO m, EventSocketIO h) => EventSocketT h m [EventSocketMessage]Source
Plays a 0 length tone stream to force a CHANNEL_EXECUTE_COMPLETE event as a synchronization point. Will wait forever if events aren't turned on.
Arguments
:: (MonadIO m, EventSocketIO h) | |
=> EventSocketCommand | Command to run. |
-> EventSocketT h m [EventSocketMessage] | List of messages up to the terminating command reply or API response. |
Runs a command of type EventSocketCommand
. Behaves roughly the same as commandAndReply
.
Arguments
:: (MonadIO m, EventSocketIO h) | |
=> [EventSocketCommand] | List of commands to perform. |
-> EventSocketT h m [EventSocketMessage] | Result is all messages returned. |
Runs a sequence of EventSocketCommand
s.
Arguments
:: (MonadIO m, EventSocketIO h) | |
=> ESUUID | UUID to look for. If blank, uses the main UUID. |
-> EventSocketT h m (Maybe (SessionState h m)) | Returns the session wrapped in Maybe. |
Gets a session if it exists.
Midlevel functions
Arguments
:: (MonadIO m, EventSocketIO h) | |
=> ByteString | API action name. |
-> ByteString | API action arguments. |
-> EventSocketT h m [EventSocketMessage] |
Sends a raw command (such as an API command) to the event socket and waits for the response.
Arguments
:: (MonadIO m, EventSocketIO h) | |
=> ByteString | Command name. |
-> ByteString | Command arguments. (Blank if none.) |
-> EventSocketT h m [EventSocketMessage] |
Sends a command and then waits for a response.
Arguments
:: (Monad m, EventSocketIO h) | |
=> ByteString | UUID to use. |
-> EventSocketT h m a | Monadic action to run. |
-> EventSocketT h m a |
Run a monadic action with the specified UUID as the current UUID. Once the action completes, the previous UUID is restored iff it is the same as the original UUID.
getUUID :: (MonadIO m, EventSocketIO h) => EventSocketT h m ESUUIDSource
Get the UUID of the main session.
Low level functions
Arguments
:: (MonadIO m, EventSocketIO h) | |
=> ByteString | API action name. |
-> ByteString | API action arguments. |
-> EventSocketT h m () |
Sends a raw command to the event socket.
Arguments
:: (MonadIO m, EventSocketIO h) | |
=> ByteString | Command name. |
-> ByteString | Command arguments. |
-> EventSocketT h m () |
Sends a command to the event socket.
Arguments
:: (MonadIO m, EventSocketIO h) | |
=> EventType | Event type to wait for. |
-> EventSocketT h m [EventSocketMessage] | Returns a list of messages up to and include the the ending event. |
Waits forever for the specified event type.
eventSocketReadEventsUntilSource
Arguments
:: (MonadIO m, EventSocketIO h) | |
=> (Maybe EventSocketMessage -> EventSocketT h m Bool) | Condition function. |
-> EventSocketT h m (Bool, [EventSocketMessage]) |
Reads messages from the event socket until a condition is true.
The handler is called with Nothing to detect whether messages should be read (for example, check if the socket has data waiting.)
At that point, the handler returns whether more messages should be read (True for more messages, False to stop reading messages.)
The handler is called on each received message.
At that the handler returns whether it is done (True for no more messages, False to continue reading messages.)
Arguments
:: EventSocketIO h | |
=> h | Connection handle. |
-> HostName | Hostname of incoming connection |
-> PortNumber | Port of incoming connection. |
-> EventSocketState h m | New state. |
Creates a new EventSocketState. You may use your own handle type and functions for reading and writing data to it.
Examples
Simple example
This example will accept an incoming Event Socket connection and play a message using the FLITE module.
It is quite simple and doesn't look at the responses when it sends commands.
An example of using both the low level and higher level esRun/esRunActions interface is shown.
module TestApp where import qualified Data.ByteString.Char8 as B import Control.Monad.State import Control.Monad.Error import Network.EventSocket import IO -- Example of using StateT with EventSocketT. type TestMonad a = EventSocketT Handle InnerMonad a type InnerMonad = StateT TestState IO data TestState = TestState { meep :: Int } deriving Show -- Entry point for when FreeSwitch makes an event socket connection to the program. -- You can also handle your own network connections and use newEventSocketState to create state to use here. testThread :: EventSocketState Handle InnerMonad -> IO () testThread est = do let inistate = TestState { meep = 1 } result <- runStateT (runEventSocketT testHandler est) inistate putStrLn $ "*** Completion: " ++ show result -- Example of an event handler. testEvent :: (MonadIO m, EventSocketIO h) => EventSocketMessage -> EventSocketT h m (Maybe (EventHandlerFunc h m), EventHandlerResult) testEvent m = do liftIO . putStrLn $ "Got event: " ++ show m return (Just $ EventHandlerFunc testEvent,EHContinue)
testEvent :: EventSocketMessage -> TestMonad (Maybe (EventHandlerFunc h m),EventHandlerResult) testEvent m = do liftIO . putStrLn $ "Got event: " ++ show m return (EventHandlerFunc testEvent,EHContinue) -- Example of using the low level interface. doCallStuffLowLevel :: TestMonad [EventSocketMessage] doCallStuffLowLevel = do sendAPI (B.pack "linger") B.empty waitForEvent E_CommandReply sendAPI (B.pack "events plain all") B.empty waitForEvent E_CommandReply commandAndReply (B.pack "answer") B.empty commandAndReply (B.pack "set") $ B.pack "tts_engine=flite" commandAndReply (B.pack "set") $ B.pack "tts_voice=kal" commandAndReply (B.pack "speak") $ B.pack "Riveting tale, chap." -- Example of using the high level interface. doCallStuffHighLevel :: TestMonad [EventSocketMessage] doCallStuffHighLevel = do esRunActions [ CmdLinger , CmdEvents { format = B.pack "plain", events = [B.pack "all"] } , CmdAnswer , CmdSet { key = B.pack "tts_engine", val = B.pack "flite" } , CmdSet { key = B.pack "tts_voice", val = B.pack "kal" } ] esRun CmdSpeak { text = B.pack "Riveting tale, chap." } -- Example of running a single action. testHandler :: TestMonad () testHandler = do st <- lift get -- Must lift to get to our state. registerEventHandler B.empty E_COMMAND 0 $ EventHandlerFunc testEvent -- Global event handler, triggering on all COMMAND events at priority 0. inimsg <- connectInbound when (meep st == 1) . liftIO $ putStrLn "Meep." doCallStuffHighLevel return () main :: IO () main = do startEventSocket "127.0.0.1" (fromIntegral 8984) testThread return ()