celparser.hs

{-# LANGUAGE OverloadedStrings, ScopedTypeVariables, TemplateHaskell #-}
import System.Locale
import Data.DateTime
import Data.Time
import Data.Monoid
import Data.Maybe (fromJust,isJust)
import Data.Functor.Identity
import Data.Text (Text)
import Data.Map.Lazy (Map)
import qualified Data.Map.Lazy as Map
import qualified Data.Text as Text
import Database.MySQL.Simple
import Control.Monad
import Control.Applicative
import Control.Monad.Trans.State.Lazy
import Lens.Simple
import Database.MySQL.Simple.QueryParams (QueryParams)
import Database.MySQL.Simple.Param (Param,render)

data EventType = ChanStart | Answer | AppStart | BridgeEnter | BridgeExit | Hangup | ChanEnd | AppEnd | LinkedIdEnd | AttendedTransfer | BlindTransfer 
    deriving (Show)

readEvType :: Text -> EventType
readEvType "CHAN_START" = ChanStart
readEvType "ANSWER" = Answer
readEvType "APP_START" = AppStart
readEvType "BRIDGE_ENTER" = BridgeEnter
readEvType "BRIDGE_EXIT" = BridgeExit
readEvType "HANGUP" = Hangup
readEvType "CHAN_END" = ChanEnd 
readEvType "APP_END" = AppEnd
readEvType "LINKEDID_END" = LinkedIdEnd
readEvType "ATTENDEDTRANSFER" = AttendedTransfer
readEvType "BLINDTRANSFER" = BlindTransfer
readEvType _ = undefined

newtype ChannelId = ChannelId { text :: Text }
                     deriving (Eq,Show,Ord)

data Event = Event {
    _evtype   :: EventType,
    _account  :: Text,
    _time     :: UTCTime,
    _callerN  :: Text,
    _exten    :: Text,
    _chanName :: Text,
    _peer     :: Text,
    _uniqueId :: ChannelId,
    _linkedId :: ChannelId 
} deriving (Show)
$(makeLenses ''Event)

data Channel = Channel {
    _chanid   :: ChannelId,
    _caller   :: Maybe Text,
    _customer :: Text,
    _name     :: Text,
    _answer   :: Maybe UTCTime,
    _hangup   :: Maybe UTCTime,
    _links    :: [Channel],
    _attended :: Bool,
    _blind    :: Bool,
    _ext      :: Maybe Text
} deriving (Show)
$(makeLenses ''Channel)

data CallDetailType = Dial | Attended | Blind
                         deriving (Show)

data CallDetail = CallDetail {
    _callid              :: ChannelId,
    _callerId            :: Maybe Text,
    _callerChannel       :: Text,
    _extension           :: Maybe Text,
    _callerAnswerDate    :: Maybe UTCTime,
    _callerHangupDate    :: Maybe UTCTime,
    _calleeChannel       :: Text,
    _calleeAnswerDate    :: Maybe UTCTime,
    _calleeHangupDate    :: Maybe UTCTime,
    _customerId          :: Text,
    _cdType              :: CallDetailType    
} deriving (Show)
$(makeLenses ''CallDetail)

data ParserState = ParserState {
    _channels    :: Map ChannelId Channel,
    _names       :: Map Text Channel,
    _calldetails :: [CallDetail]
{-
    _bridges     :: [(Channel,Channel)]
-}
} deriving (Show)
$(makeLenses ''ParserState)

type Parser m a = StateT ParserState m a

parseEvents :: (Functor m, Monad m) => [Event] -> Parser m ()
parseEvents xs = void $ forM xs parseEvent

parseEvent :: Monad m => Event -> Parser m ()
parseEvent ev@Event { _evtype = ChanStart } = do
    names %= Map.insert (ev ^. chanName) chan
    where chan = Channel { _chanid = ev ^. uniqueId, _name = ev ^. chanName,
                           _answer = Nothing, _hangup = Nothing,
                           _links = [], _attended = False,
                           _blind = False, _ext = Nothing,
                           _caller = Nothing, _customer = ev ^. account }
parseEvent ev@Event{ _evtype = AppStart } = names %= Map.update (\ch -> Just $ (ch & (set ext (Just $ ev ^. exten)) & (set caller (Just $ ev ^. callerN)))) (ev ^. chanName)
parseEvent ev@Event{ _evtype = Answer } = names %= Map.update (\ch -> Just $ set answer (Just $ ev ^. time) ch) (ev ^. chanName)
parseEvent ev@Event{ _evtype = Hangup } = names %= Map.update (\ch -> Just $ set hangup (Just $ ev ^. time) ch) (ev ^. chanName)
parseEvent ev@Event{ _evtype = BridgeEnter } = when (ev ^. peer /= "") $ use names >>= \m -> do
    let c1 = Map.lookup (ev ^. peer) m
    let c2 = Map.lookup (ev ^. chanName) m
    --names %= Map.update (\ch -> Just $ (over links ((:) $ fromJust c2)) ch) (ev ^. peer)
    names %= Map.update (\ch -> Just $ (over links ((:) $ fromJust c1)) ch) (ev ^. chanName)
{--
parseEvent ev@Event{ _evtype = BridgeExit } = when (ev ^. peer /= "") $ use names >>= \m -> do
    let c1 = Map.lookup (ev ^. peer) m
    let c2 = Map.lookup (ev ^. chanName) m
    names %= Map.update (\ch -> Just $ (over links (tail)) ch) (ev ^. peer)
    names %= Map.update (\ch -> Just $ (over links (tail)) ch) (ev ^. chanName)
--}
parseEvent ev@Event{ _evtype = AttendedTransfer } = use names >>= \m -> do
    names %= Map.update (\ch -> Just $ set attended True ch) (ev ^. chanName)
parseEvent ev@Event{ _evtype = BlindTransfer } = use names >>= \m -> do
    names %= Map.update (\ch -> Just $ set blind True ch) (ev ^. chanName)
parseEvent ev@Event{ _evtype = LinkedIdEnd } = use names >>= \m -> do
    xs <- forM (Map.toList m) $ \(_, mainChannel) -> return $ flip map (mainChannel ^. links) $ \link -> do
            let c = fromJust $ Map.lookup (link ^. name) m
            CallDetail { _callid = ev ^. linkedId, _callerId = link ^. caller, _calleeChannel = mainChannel ^. name, _callerChannel = link ^. name,
                         _calleeAnswerDate = mainChannel ^. answer, _callerAnswerDate = c ^. answer, 
                         _calleeHangupDate = mainChannel ^. hangup, _callerHangupDate = c ^. hangup, _cdType = getType mainChannel,
                         _extension = link ^. ext, _customerId = mainChannel ^. customer }
    calldetails .= (concat xs)
    where getType c = if c ^. attended
                      then Attended
                      else if c ^. blind
                           then Blind
                           else Dial
parseEvent _ =  return ()

run = do
    let ci = defaultConnectInfo { connectHost = "", connectUser = "",
                connectPassword = "", connectDatabase = "" }
    conn <- connect ci
    xs <- query_ conn "select eventtype, eventtime, channame, peer, exten, cid_name, cid_num, uniqueid, linkedid, accountcode from cloud_pbx_cel where linkedid = 1437383610.3645" -- attended
    --xs <- query_ conn "select eventtype, eventtime, channame, peer, exten, cid_name, cid_num, uniqueid, linkedid, accountcode from cloud_pbx_cel where linkedid = 1437147458.3514" -- blind
    --xs <- query_ conn "select eventtype, eventtime, channame, peer, exten, cid_name, cid_num, uniqueid, linkedid, accountcode from cloud_pbx_cel where linkedid = 1437124048.3472" -- dial
    events <- flip mapM xs $ \(evtype :: Text, eventtime :: UTCTime, channame :: Text, peer :: Text, exten :: Text, cid_name :: Text, cid_num :: Text, uniqueId:: Text, linkedId :: Text, accountCode :: Text) ->
        return $ Event { _evtype = (readEvType evtype), _time = eventtime, _chanName = channame, _callerN = cid_name <> " <" <> cid_num <> ">", _exten = exten, _peer = peer, _uniqueId = ChannelId uniqueId, _linkedId = ChannelId linkedId, _account = accountCode }
    -- forM events print
    let st = snd $ runIdentity $ runStateT (parseEvents events) ParserState { _channels = Map.empty, _calldetails = [], _names = Map.empty }
    forM (filter (\cd -> isJust $ cd ^. extension) $ st ^. calldetails) $ \cd ->
        execute conn "insert into cloud_pbx_call_details(call_id, customer_id, calling_channel_id, calling_answer_date, calling_hangup_date, linked_answer_date, linked_hangup_date, linked_channel_id, extension, type) values(?, ?, ?, ?, ?, ?, ?, ?, ?, ?)"  (text $ cd ^. callid, cd ^. customerId, cd ^. callerChannel, cd ^. callerAnswerDate, cd ^. callerHangupDate, cd ^. calleeAnswerDate, cd ^. calleeHangupDate, cd ^. calleeChannel, cd ^. extension, show $ cd ^. cdType)
    return ()

main = print <$> run