diff --git a/AGI.cabal b/AGI.cabal --- a/AGI.cabal +++ b/AGI.cabal @@ -2,11 +2,11 @@ Category: Network Synopsis: A library for writing AGI scripts for Asterisk Description: Asterisk is an open-source Voice over IP server - (VoIP). Asterisk provides a Asterisk Gateway Interface (AGI), which + (VoIP). Asterisk provides an Asterisk Gateway Interface (AGI), which can be used to write external programs that interact with Asterisk. It is typically used for creating Interactive Voice Response (IVR) systems. -Version: 1.0 +Version: 1.1 License: BSD3 License-File: debian/copyright Author: Jeremy Shaw diff --git a/Network/AGI.hs b/Network/AGI.hs --- a/Network/AGI.hs +++ b/Network/AGI.hs @@ -1,27 +1,77 @@ {-# OPTIONS_GHC -fglasgow-exts #-} -module Network.AGI where +module Network.AGI + ( Digit(..) + , AGI + , run + , ppDigit + , ppEscapeDigits + , SoundType(..) + , sendRecv + , answer + , hangUp + , getData + , RecordResult(..) + , sayDigits + , sayNumber + , streamFile + , waitForDigit + ) where import Control.Monad import Control.Monad.Trans import Control.Monad.Reader +import Control.Monad.Error +import Data.Char import Data.Maybe import Data.Word import Text.ParserCombinators.Parsec import System.IO import System.Posix.Signals +import System.Random newtype AGI a = AGI { runAGI :: ReaderT [(String, String)] IO a } - deriving (Monad, MonadIO, Functor) + deriving (Monad, MonadIO, Functor, MonadError IOError, MonadReader [(String, String)]) -type EscapeDigits = String +data Digit + = Pound + | Star + | Zero + | One + | Two + | Three + | Four + | Five + | Six + | Seven + | Eight + | Nine + deriving (Eq, Ord, Read, Show, Enum) + +ppDigit :: Digit -> Char +ppDigit Pound = '#' +ppDigit Star = '*' +ppDigit Zero = '0' +ppDigit One = '1' +ppDigit Two = '2' +ppDigit Three = '3' +ppDigit Four = '4' +ppDigit Five = '5' +ppDigit Six = '6' +ppDigit Seven = '7' +ppDigit Eight = '8' +ppDigit Nine = '9' + +ppEscapeDigits :: [Digit] -> String +ppEscapeDigits digits = '"' : (map ppDigit digits ++ "\"") + type Command = String -data Timeout = Timeout Word (Maybe Word) -- ^ timeout, max digits -type ReturnCode = Word +-- data Timeout = Timeout Word (Maybe Word) -- ^ timeout, max digits -data SoundType = Wav | GSM +data SoundType = WAV | GSM + deriving Eq instance Show SoundType where - show Wav = "wav" + show WAV = "wav" show GSM = "gsm" -- TODO: let user install a custom sipHUP handler (sigHUP is sent when the caller hangs ups) @@ -50,81 +100,346 @@ _ -> let (a,v) = break ((==) ':') l in return (Just (a, dropWhile ((==) ' ') (tail v))) -sendRecv :: Command -> AGI (ReturnCode, String) +sendRecv :: Command -> AGI String sendRecv cmd = liftIO $ do putStrLn cmd - l <- getLine - let (c,r) = break ((==) ' ') l - return (read c, tail r) - -parseResult :: CharParser () (Int, Bool) -parseResult = - do string "result=" - digits <- many1 $ oneOf ('-':['0'..'9']) - skipMany (char ' ') - timeout <- parseTimeout - return (read digits, timeout) + getLine -parseTimeout :: CharParser () Bool -parseTimeout = - do string "(timeout)" - return True - <|> - do return False +{- +Usage: ANSWER -answer :: AGI Bool +Answers channel if not already in answer state. + +Returns: +failure: 200 result=-1 +success: 200 result=0 +-} +-- |'answer' channel if not already in answer state +answer :: AGI Bool -- ^ True on success, False on failure answer = - do (code, res) <- sendRecv "ANSWER" - case res of - "result=0" -> - return $ True - _ -> - return $ False + do res <- sendRecv "ANSWER" + parseResult (pResult >> pSuccessFailure) res -hangUp :: Maybe String -> AGI (ReturnCode, String) +{- + Usage: HANGUP [] + +Hangs up the specified channel. + +If no channel name is given, hangs up the current channel. + +Returns: +failure: 200 result=-1 +success: 200 result=1 +-} +hangUp :: Maybe String -> AGI Bool hangUp mChannel = - sendRecv ("HANGUP" ++ (fromMaybe "" mChannel)) + do res <- sendRecv ("HANGUP" ++ (maybe "" (' ' :) mChannel)) + parseResult (pResult >> ((char '1' >> return True) <|> (string "-1" >> return False))) res +{- +Usage: GET DATA [timeout] [max digits] + +Returns: +failure: 200 result=-1 +timeout: 200 result= (timeout) +success: 200 result= + + is the digits pressed. + +-} + -- TODO: does digit include # and * ? -getData :: FilePath -> Maybe Timeout -> AGI (ReturnCode, (Int, Bool)) -getData fp mTimeout = - let cmd = +-- default timeout is 2000 ms +getData :: FilePath -- ^ file to stream + -> Maybe Integer -- ^ timout in ms after keypress (default: 2000 ms) + -> Maybe Integer -- ^ max + -> AGI (Maybe ([Digit], Bool)) -- ^ Nothing on failure, Just (digits, timeout) on success +getData fp mTimeout mMaxDigits = + let cmd = "GET DATA " ++ fp ++ - case mTimeout of - Nothing -> "" - Just (Timeout timeout mMaxDigits) -> - " " ++ show timeout ++ - case mMaxDigits of - Nothing -> "" - Just maxDigits -> " " ++ show maxDigits + case (mTimeout, mMaxDigits) of + (Nothing, Nothing) -> "" + (Just timeout, Nothing) -> show timeout + (Nothing, Just maxDigits) -> "2000 " ++ show maxDigits + (Just timeout, Just maxDigits) -> show timeout ++" "++ show maxDigits + in - do (code, res) <- sendRecv cmd - case parse parseResult res res of - Left e -> - return $ (code, ((-1), False)) - Right (digits,timeout) -> - return $ (code, (digits, timeout)) + do res <- sendRecv cmd + parseResult p res + where + p = do pResult + (try pFail >> return Nothing) <|> (pDigitsWithTimeout >>= return . Just) + pFail = string "-1" +{- +Usage: RECORD FILE [offset samples] [BEEP] [s=] -record :: FilePath -> SoundType -> EscapeDigits -> Word -> Bool -> AGI (ReturnCode, String) -record fp st escapeDigits length beep = - sendRecv $ "RECORD FILE " ++ fp ++ " " ++ show st ++ " " ++ show escapeDigits ++ " " ++ show length ++ (if beep then " beep" else "") - --- TODO: does digit include # and * ? -sayNumber :: Int -> EscapeDigits -> AGI (ReturnCode, String) -sayNumber num escapeDigits = - sendRecv $ "SAY NUMBER " ++ (show num) ++ " " ++ show escapeDigits +Returns: +failure to write: 200 result=-1 (writefile) +failure on waitfor: 200 result=-1 (waitfor) endpos= +hangup: 200 result=0 (hangup) endpos= +interrrupted: 200 result= (dtmf) endpos= +timeout: 200 result=0 (timeout) endpos= +random error: 200 result= (randomerror) endpos= + + is the end offset in the file being recorded. + is the ascii code for the digit pressed. + ????? +-} --- TODO: what if the users enters DTMF -stream :: FilePath -> EscapeDigits -> AGI (ReturnCode, String) -stream fp ed = - sendRecv $ "STREAM FILE " ++ fp ++ " " ++ show ed +data RecordResult + = FailureToWrite + | FailureOnWaitFor + | HangUp + | Interrupted Digit + | Timeout + | RandomError String + deriving (Eq, Show) --- TODO: does digit include # and * ? --- TODO: positive timeouts only -waitForDigit :: Integer -> AGI (Maybe Int) +record :: FilePath -- ^ record to this file + -> SoundType -- ^ |GSM \| WAV| + -> [Digit] -- ^ stop recording if one of these digits is entered + -> Integer -- ^ maximum record time in milliseconds, -1 for no timeout + -> Maybe Integer -- ^ offset samples + -> Bool -- ^ beep to indicate recording has begun + -> Maybe Integer -- ^ stop recording if this many seconds of silence passes + -> AGI (RecordResult, Integer) -- ^ exit condition, endpos=offset +record fp soundType escapeDigits length offset beep silence = + do res <- sendRecv $ ("RECORD FILE " ++ fp ++ " " ++ show soundType ++ " " ++ + ppEscapeDigits escapeDigits ++ " " ++ show length ++ + (maybe "" (\o -> ' ': show o) offset) ++ + (if beep then " beep" else "") ++ + (maybe "" (\s -> " s=" ++ show s) silence)) + parseResult p res + where + p = pResult >> (pFailureToWrite <|> pFailureOnWaitFor <|> pHangUp <|> pInterrupted <|> pTimeout <|> pRandomError) + pFailureToWrite = + do try (string "-1 (writefile)") >> return (FailureToWrite, 0) + pFailureOnWaitFor = + do try (string "-1 (waitfor)") + pSpace + ep <- pEndPos + return (FailureOnWaitFor, ep) + pHangUp = + do try (string "0 (hangup)") + pSpace + ep <- pEndPos + return (HangUp, ep) + pInterrupted = try $ + do digit <- pDigit + pSpace + string "(dtmf)" + pSpace + ep <- pEndPos + return (Interrupted digit, ep) + pTimeout = + do try (string "0 (timeout)") + pSpace + ep <- pEndPos + return (Timeout, ep) + pRandomError = try $ + do error <- manyTill anyChar (try (string " (randomerror)")) + pSpace + ep <- pEndPos + return (RandomError error, ep) + +{- + Usage: SAY DIGITS + +Say a given digit string, returning early if any of the given DTMF digits are received on the channel. + +EXAMPLE: + +SAY DIGITS 5551212 "125#" + + +The digits five, five, five, one, two, one, two will be spoken out, If durning the speech, the DTMF keys 1, 2, 5 or # are pressed it will stop the playback. + +Returns: +failure: 200 result=-1 +success: 200 result=0 +digit pressed: 200 result= + + is the ascii code for the digit pressed. +-} + +sayDigits :: [Digit] -> [Digit] -> AGI (Maybe (Maybe Digit)) +sayDigits digits escapeDigits = + do res <- sendRecv $ "SAY DIGITS " ++ map ppDigit digits ++ " " ++ ppEscapeDigits escapeDigits + parseResult p res + where + p = do pResult + (string "-1" >> return Nothing) <|> (string "0" >> return (Just Nothing)) <|> (pAsciiDigit >>= return . Just . Just) + +{- +SAY NUMBER + +Say a given number, returning early if any of the given DTMF digits are received on the channel. + +EXAMPLE: + + SAY NUMBER 1234 "1*#" + +The number one thousand two hundred and thirty four will be spoken, and if the DTMFs 1, * or # is pressed during the speach it will be terminated. + +Returns: +failure: 200 result=-1 +success: 200 result=0 +digit pressed: 200 result= + + is the ascii code for the digit pressed. +-} +-- | 'sayNumber' says the specified number +sayNumber :: Integer -- ^ number to say + -> [Digit] -- ^ return early if any of these digits are received + -> AGI (Maybe (Maybe Digit)) -- ^ Nothing on failure, Just Nothing on success, Just (Just ) if key is pressed +sayNumber number escapeDigits = + do res <- sendRecv ("SAY NUMBER " ++ show number ++ " " ++ ppEscapeDigits escapeDigits) + parseResult p res + where + p = do pResult + (string "-1" >> return Nothing) <|> (string "0" >> return (Just Nothing)) <|> (pAsciiDigit >>= return . Just . Just) + +{- +Usage: STREAM FILE [sample offset] + +Send the given file, allowing playback to be interrupted by the given digits, if any. + +Use double quotes for the digits if you wish none to be permitted. + +If sample offset is provided then the audio will seek to sample offset before play starts. + +Remember, the file extension must not be included in the filename. + +Returns: +failure: 200 result=-1 endpos= +failure on open: 200 result=0 endpos=0 +success: 200 result=0 endpos= +digit pressed: 200 result= endpos= + + is the stream position streaming stopped. If it equals there was probably an error. + is the ascii code for the digit pressed. + +Bugs +STREAM FILE is known to behave inconsistently, especially when used in conjuction with other languages, i.e. Set(LANGUAGE()=xy). +Workaround: Use EXEC PLAYBACK instead. +-} + +streamFile :: FilePath -- ^ file to stream + -> [Digit] -- ^ escape digits + -> Maybe Integer -- ^ sample offset + -> AGI (Either Integer (Maybe Digit, Integer)) -- ^ On failure: Left . On success: Right (Maybe Digit, ) +streamFile filePath escapeDigits mSampleOffset = + do res <- sendRecv $ "STREAM FILE " ++ filePath ++ " " ++ ppEscapeDigits escapeDigits ++ (maybe "" (\so -> ' ' : show so) mSampleOffset) + parseResult p res + where + p = + do pResult + pFailure <|> pFailureOnOpen <|> pSuccess <|> pSuccessWithDigit + pFailure = + do string "-1" + pSpace + ep <- pEndPos + return (Left ep) + pFailureOnOpen = try $ + do string "0 endpos=0" + return (Left 0) + pSuccess = try $ + do string "0" + pSpace + ep <- pEndPos + return (Right (Nothing, ep)) + pSuccessWithDigit = try $ + do d <- pAsciiDigit + pSpace + ep <- pEndPos + return (Right ((Just d), ep)) + +{- +Usage: WAIT FOR DIGIT + +Waits up to milliseconds for channel to receive a DTMF digit. + +Use -1 for the value if you desire the call to block indefinitely. + +Returns: +failure: 200 result=-1 +timeout: 200 result=0 +success: 200 result= + + is the ascii code for the digit received. +-} + +-- |wait for channel to receive a DTMF digit. +waitForDigit :: Integer -- ^ timeout in milliseconds, -1 to block indefinitely + -> AGI (Maybe (Maybe Digit)) -- ^ |Nothing| on error, |Just Nothing| on timeout, |Just (Just )| on success waitForDigit timeout = - do (code, res) <- sendRecv $ "WAIT FOR DIGIT " ++ show timeout - case parse parseResult res res of - Left e -> return Nothing -- error ? - Right (ascii, _) -> return (Just (ascii - 48)) - + do res <- sendRecv $ "WAIT FOR DIGIT " ++ show timeout + parseResult p res + where + p = do pResult + (string "-1" >> return Nothing) <|> (string "0" >> return (Just Nothing)) <|> (pAsciiDigit >>= return . Just . Just) + + +-- * Result Parsers +parseResult p res = + case parse p res res of + (Left e) -> throwError (userError (show e)) + (Right r) -> return $ r + +-- |parse 0 as True, -1 as failure +pSuccessFailure :: CharParser () Bool +pSuccessFailure = + (char '0' >> return True) <|> (string "-1" >> return False) + +-- |parse '200 result=' +pResult :: CharParser () String +pResult = string "200 result=" + +-- |parse a block of zero or more ' ' and '\t' characters (but not '\n') +pSpace :: CharParser () String +pSpace = many (tab <|> char ' ') + +pDigitsWithTimeout = + do digits <- many pDigit + pSpace + to <- (string "(timeout)" >> return True) <|> return False + return (digits, to) + +pDigit :: CharParser () Digit +pDigit = + (char '#' >> return Pound) <|> + (char '*' >> return Star) <|> + (char '0' >> return Zero) <|> + (char '1' >> return One) <|> + (char '2' >> return Two) <|> + (char '3' >> return Three) <|> + (char '4' >> return Four) <|> + (char '5' >> return Five) <|> + (char '6' >> return Six) <|> + (char '7' >> return Seven) <|> + (char '8' >> return Eight) <|> + (char '9' >> return Nine) + +pAsciiDigit :: CharParser () Digit +pAsciiDigit = + do ds <- many1 digit + case ds of + "35" -> return Pound + "42" -> return Star + "48" -> return Zero + "49" -> return One + "50" -> return Two + "51" -> return Three + "52" -> return Four + "53" -> return Five + "54" -> return Six + "55" -> return Seven + "56" -> return Eight + "57" -> return Nine + _ -> pzero "The ascii character code " ++ ds ++ " (" ++ [chr (read ds)] ++ ") does not correspond to a digit on the keypad" + +pEndPos :: CharParser () Integer +pEndPos = + do string "endpos=" + ds <- many1 digit + return (read ds) diff --git a/debian/changelog b/debian/changelog --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,9 @@ +haskell-agi (1.1) unstable; urgency=low + + * Major rewrite of internals, some API breakage + + -- Jeremy Shaw Sun, 13 May 2007 14:18:46 -0700 + haskell-agi (1.0) unstable; urgency=low * Initial Debian package. diff --git a/examples/guessinggame/GuessingGame.hs b/examples/guessinggame/GuessingGame.hs --- a/examples/guessinggame/GuessingGame.hs +++ b/examples/guessinggame/GuessingGame.hs @@ -27,31 +27,42 @@ playGame :: AGI () playGame = - do secretDigit <- liftIO $ randomRIO (0, 9) - stream "guessing-game-intro" [] - guess <- waitForDigit (-1) - play (compare secretDigit) (fromMaybe 0 guess) + do secretIndex <- liftIO $ randomRIO (0, 9) + let secretDigit = [Zero .. Nine] !! secretIndex + streamFile "guessing-game-intro" [] Nothing + mGuess <- waitForDigit (-1) + let firstGuess = + case mGuess of + (Just (Just digit)) -> digit + _ -> Zero + play (compare secretDigit) firstGuess return () +play :: (Digit -> Ordering) -> Digit -> AGI () play oracle guess = loop guess where loop guess = case oracle guess of LT -> - do stream "guessing-game-lower" [] - sayNumber guess [] - nextGuess <- waitForDigit (-1) - loop (fromMaybe guess nextGuess) + do streamFile "guessing-game-lower" [] Nothing + sayDigits [guess] [] + mNextGuess <- waitForDigit (-1) + case mNextGuess of + (Just (Just nextGuess)) -> loop nextGuess + _ -> loop guess GT -> - do stream "guessing-game-higher" [] - sayNumber guess [] - nextGuess <- waitForDigit (-1) - loop (fromMaybe guess nextGuess) + do streamFile "guessing-game-higher" [] Nothing + sayDigits [guess] [] + mNextGuess <- waitForDigit (-1) + case mNextGuess of + (Just (Just nextGuess)) -> loop nextGuess + _ -> loop guess EQ -> - do stream "guessing-game-yay" [] - sayNumber guess [] - stream "guessing-game-correct" [] + do streamFile "guessing-game-yay" [] Nothing + sayDigits [guess] [] + streamFile "guessing-game-correct" [] Nothing + return () {-