EventSocket-0.1: Interfaces with FreeSwitch Event Socket.

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/)

Synopsis

Types

Messages

data EventSocketMessage Source

Basically, an event. Used and returned by some of the lower level Eventsocket routines.

Constructors

EventSocketMessage 

Fields

esmType :: EventType

Type of the event.

esmHeaders :: EvtKVMap

The headers FreeSwitch sent.

esmSuccess :: Bool

Is this a positive response?

esmData :: Either ByteString EvtKVMap

Either a ByteString or a parsed KV map depending on the type of response.

Base types

data EventSocketIO h => EventSocketState h m Source

The state of the event socket connection.

data EventType Source

Mainly FreeSwitch events.

More information for FreeSwitch-specific events: http://wiki.freeswitch.org/wiki/Event_list

data EventSocketCommand Source

Event Socket commands. This list is far from complete.

More information is available: http://wiki.freeswitch.org/wiki/Command_reference

Constructors

CmdEvents

http://wiki.freeswitch.org/wiki/Event_Socket#event

Fields

format :: ByteString

Event format, either plain or XML.

events :: [ByteString]

Event types.

CmdFilter

http://wiki.freeswitch.org/wiki/Event_Socket#filter

Fields

isDelete :: Bool

Delete this filter instead of creating.

eventHeader :: ByteString

Header to allow.

eventValue :: ByteString

Value to allow.

CmdLinger

Turns on event socket linger, causing the event socket to send all remaining events before closing the connection.

CmdSet

Sets a channel variable.

Fields

key :: ByteString

Set key.

val :: ByteString

Set value.

CmdHangup

Hangs up the call. (Uses the UUID in the event socket state.)

CmdSleep

Sleeps the specified number of milliseconds. http://wiki.freeswitch.org/wiki/Misc._Dialplan_Tools_sleep

Fields

duration :: Int

Duration to sleep.

CmdAnswer

Answers the call.

CmdPlayGather

Plays a sound file and waits for input. http://wiki.freeswitch.org/wiki/Misc._Dialplan_Tools_play_and_get_digits

CmdBridge

Bridges a call. http://wiki.freeswitch.org/wiki/Misc._Dialplan_Tools_bridgecall

CmdSay

Can speak simple output like digits or time. http://wiki.freeswitch.org/wiki/Misc._Dialplan_Tools_say

Fields

text :: ByteString
 
CmdSpeak

Can speak arbitrary text using a TTS engine. http://wiki.freeswitch.org/wiki/Misc._Dialplan_Tools_speak

Fields

text :: ByteString
 
CmdPlay

Plays a sound file. http://wiki.freeswitch.org/wiki/Misc._Dialplan_Tools_playback

Fields

filename :: ByteString
 
CmdRecord

Records a sound file. http://wiki.freeswitch.org/wiki/Misc._Dialplan_Tools_record

CmdMetaApp

Binds a meta application. http://wiki.freeswitch.org/wiki/Misc._Dialplan_Tools_bind_meta_app

CmdSync

Sync point.

data EventSocketIO h => SessionState h m Source

Stores a session. Two user accessible fields exist:

  • sessUUID :: ESUUID -- The UUID this session is associated with.
  • sessVariables :: EvtKVMap -- Variables associated with this channel, updated when receiving CHANNEL_DATA events from FreeSwitch.

Instances

type EvtKVMap = Map ByteString ByteStringSource

Just a simple map ByteString to ByteString.

type ESUUID = ByteStringSource

UUIDs are currently just bytestrings.

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

esioBReadLineSource

Arguments

:: h 
-> IO ByteString

Read one line from the handle.

esioBReadSource

Arguments

:: h 
-> Int 
-> IO ByteString

Read a specified amount of bytes from the handle.

esioBWriteSource

Arguments

:: h 
-> ByteString 
-> IO ()

Write to the handle

esioFlushSource

Arguments

:: h 
-> IO ()

Flush the handle.

esioReadySource

Arguments

:: h 
-> IO Bool

Check if the handle is ready for reading.

Instances

EventSocketIO Handle

There exists a default instance for Handle.

Classes

Provided functions

Utility functions

startEventSocketSource

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.

runEventSocketTSource

Arguments

:: (MonadIO m, EventSocketIO h) 
=> EventSocketT h m a

Monadic action to run.

-> EventSocketState h m

Initial state (possibly from newEventSocketState)

-> 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

registerEventHandlerSource

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.

unregisterEventHandlerSource

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.

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.

esRunSource

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.

esRunActionsSource

Arguments

:: (MonadIO m, EventSocketIO h) 
=> [EventSocketCommand]

List of commands to perform.

-> EventSocketT h m [EventSocketMessage]

Result is all messages returned.

Runs a sequence of EventSocketCommands.

getSessionSource

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

apiAndReplySource

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.

commandAndReplySource

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.

withUUIDSource

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

sendAPISource

Arguments

:: (MonadIO m, EventSocketIO h) 
=> ByteString

API action name.

-> ByteString

API action arguments.

-> EventSocketT h m () 

Sends a raw command to the event socket.

sendCommandSource

Arguments

:: (MonadIO m, EventSocketIO h) 
=> ByteString

Command name.

-> ByteString

Command arguments.

-> EventSocketT h m () 

Sends a command to the event socket.

waitForEventSource

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.)

newEventSocketStateSource

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 ()