transaq-connector/src/Transaq.hs

{-# LANGUAGE BangPatterns          #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE RecordWildCards       #-}

module Transaq
  (
    CommandConnect(..),
    Language(..),
    TransaqCommand(..),
    TransaqResponseC(..),
    TransaqResponse(..),
    SecurityId(..),
    CommandDisconnect(..),
    CommandServerStatus(..),
    CommandSubscribe(..),
    CommandNewOrder(..),
    CommandCancelOrder(..),
    CommandGetSecuritiesInfo(..),
    CommandGetHistoryData(..),
    CommandChangePass(..),
    ResponseResult(..),
    ResponseCandles(..),
    ResponseServerStatus(..),
    ResponseCandleKinds(..),
    ResponseMarkets(..),
    ResponseSecurities(..),
    ResponseSecInfo(..),
    ResponseQuotations(..),
    ResponseAllTrades(..),
    ResponseTrades(..),
    ResponseQuotes(..),
    ResponseOrders(..),
    ResponseClient(..),
    ClientData(..),
    Quotation(..),
    Quote(..),
    TradeNotification(..),
    OrderNotification(..),
    OrderStatus(..),
    AllTradesTrade(..),
    Tick(..),
    ConnectionState(..),
    MarketInfo(..),
    Security(..),
    CandleKind(..),
    ResponseCandlesStatus(..),
    Candle(..),
    UnfilledAction(..),
    TradeDirection(..)
  ) where

import           Control.Applicative   ((<|>))
import           Control.Error.Util    (hush)
import           Control.Monad         (void)
import           Data.Attoparsec.Text  (Parser, char, decimal, many',
                                        maybeResult, parse, parseOnly,
                                        skipSpace)
import           Data.Decimal          (DecimalRaw (..))
import           Data.Int              (Int64)
import           Data.Maybe            (catMaybes, fromMaybe, mapMaybe,
                                        maybeToList)
import qualified Data.Text             as T
import           Data.Time             (fromGregorian)
import           Data.Time.Clock       (UTCTime (UTCTime))
import           Text.Read             (readMaybe)
import           Text.XML.Light        (Attr (..), CData (cdData),
                                        Element (elName), Node (..), QName (..),
                                        elChildren, findAttr, findChild,
                                        onlyText, strContent, unode)
import           Text.XML.Light.Output (showElement)
import           Text.XML.Light.Types  (Element (elContent), blank_name)

data Language = LanguageRu | LanguageEn
  deriving (Show, Eq, Ord)

instance Node Language where
  node n LanguageRu = node n ("ru" :: String)
  node n LanguageEn = node n ("en" :: String)

type TransaqPrice = DecimalRaw Int

strAttr :: String -> String -> Attr
strAttr key val = Attr { attrKey = blank_name { qName = key}, attrVal = val}

fromBool :: Bool -> String
fromBool True  = "true"
fromBool False = "false"

parseTimestamp :: T.Text -> Maybe UTCTime
parseTimestamp = hush . parseOnly parser
  where
    parser = parseWithDate <|> (UTCTime epoch <$> parseTime)
    parseWithDate = do
      !date <- parseDate
      skipSpace
      !time <- parseTime
      pure $ UTCTime date time
    parseDate = do
      !day <- decimal
      void $ char '.'
      !month <- decimal
      void $ char '.'
      !year <- decimal
      pure $ fromGregorian year month day

    parseTime = do
      !hour <- (decimal :: Parser Int)
      void $ char ':'
      !minute <- decimal
      void $ char ':'
      !second <- decimal
      msecs <- many' $ do
        void $ char '.'
        (decimal :: Parser Int)
      let !secofday = hour * 3600 + minute * 60 + second
      case msecs of
        [!ms] -> pure $ fromIntegral secofday + fromIntegral ms / 1000.0
        _     -> pure $ fromIntegral secofday
    epoch = fromGregorian 1970 1 1


class TransaqCommand t where
  toXml :: t -> T.Text

class TransaqResponseC t where
  fromXml :: Element -> Maybe t

data CommandConnect =
  CommandConnect
  {
    login          :: !T.Text,
    password       :: !T.Text,
    host           :: !T.Text,
    port           :: !Int,
    language       :: !Language,
    autopos        :: !Bool,
    micexRegisters :: !Bool,
    milliseconds   :: !Bool,
    utcTime        :: !Bool,
    proxy          :: (), -- not supported
    rqDelay        :: !(Maybe Int),
    sessionTimeout :: !(Maybe Int),
    requestTimeout :: !(Maybe Int),
    pushULimits    :: !(Maybe Int),
    pushPosEquity  :: !(Maybe Int)
  } deriving (Show, Eq, Ord)

instance Node CommandConnect where
  node n CommandConnect {..} = node n (attrs, subnodes)
    where
      attrs = [strAttr "id" "connect"]
      subnodes =
        [ unode "login" (T.unpack login)
        , unode "password" (T.unpack password)
        , unode "host" (T.unpack host)
        , unode "port" (show port)
        , unode "language" language
        , unode "autopos" (fromBool autopos)
        , unode "micex_registers" (fromBool micexRegisters)
        , unode "milliseconds" (fromBool milliseconds)
        , unode "utc_time" (fromBool utcTime)
        ]
        ++ maybeToList (unode "rqdelay" . show <$> rqDelay)
        ++ maybeToList (unode "session_timeout" . show <$> sessionTimeout)
        ++ maybeToList (unode "request_timeout" . show <$> requestTimeout)
        ++ maybeToList (unode "push_u_limits" . show <$> pushULimits)
        ++ maybeToList (unode "push_pos_limits" . show <$> pushPosEquity)

instance TransaqCommand CommandConnect where
  toXml = T.pack . showElement . unode "command"

data CommandDisconnect = CommandDisconnect
  deriving (Show, Eq, Ord)

instance TransaqCommand CommandDisconnect where
  toXml CommandDisconnect = T.pack . showElement $ unode "command" [strAttr "id" "disconnect"]

data SecurityId =
  SecurityId
  {
    board   :: !T.Text
  , seccode :: !T.Text
  } deriving (Show, Eq, Ord)

data CommandServerStatus = CommandServerStatus
  deriving (Show, Eq, Ord)

instance TransaqCommand CommandServerStatus where
  toXml CommandServerStatus = T.pack . showElement $ unode "command" [strAttr "id" "server_status"]


instance Node SecurityId where
  node n SecurityId {..} = node n
    [ unode "board" (T.unpack board)
    , unode "seccode" (T.unpack seccode)
    ]

data CommandSubscribe =
  CommandSubscribe
  {
    alltrades  :: ![SecurityId]
  , quotations :: ![SecurityId]
  , quotes     :: ![SecurityId]
  } deriving (Show, Eq, Ord)

instance TransaqCommand CommandSubscribe where
  toXml CommandSubscribe {..} =
    T.pack . showElement $ unode "command" ([strAttr "id" "subscribe"],
      [ unode "alltrades" $ fmap (unode "security") alltrades
      , unode "quotations" $ fmap (unode "security") quotations
      , unode "quotes" $ fmap (unode "security") quotes
      ])

data CommandUnsubscribe =
  CommandUnsubscribe
  {
    alltrades  :: ![SecurityId]
  , quotations :: ![SecurityId]
  , quotes     :: ![SecurityId]
  } deriving (Show, Eq, Ord)

instance TransaqCommand CommandUnsubscribe where
  toXml CommandUnsubscribe {..} =
    T.pack . showElement $ unode "command" ([strAttr "id" "unsubscribe"],
      [ unode "alltrades" $ fmap (unode "security") alltrades
      , unode "quotations" $ fmap (unode "security") quotations
      , unode "quotes" $ fmap (unode "security") quotes
      ])

data CommandGetHistoryData =
  CommandGetHistoryData
  {
    security :: !SecurityId
  , periodId :: !Int
  , count    :: !Int
  , reset    :: !Bool
  } deriving (Show, Eq, Ord)

instance TransaqCommand CommandGetHistoryData where
  toXml CommandGetHistoryData {..} =
    T.pack . showElement $ unode "command" ([strAttr "id" "gethistorydata"],
      [ unode "security" security
      , unode "period" (show periodId)
      , unode "count" (show count)
      , unode "reset" (fromBool reset)
      ])

data TradeDirection = Buy | Sell
  deriving (Show, Eq, Ord)

instance Node TradeDirection where
  node n Buy  = node n ("B" :: String)
  node n Sell = node n ("S" :: String)

data UnfilledAction =
    UnfilledPutInQueue
  | UnfilledFOK
  | UnfilledIOC
  deriving (Show, Eq, Ord)

instance Node UnfilledAction where
  node n UnfilledPutInQueue = node n ("PutInQueue" :: String)
  node n UnfilledFOK        = node n ("FOK" :: String)
  node n UnfilledIOC        = node n ("IOC" :: String)

data CommandNewOrder =
  CommandNewOrder
  {
    security  :: !SecurityId
  , client    :: !T.Text
  , unionCode :: !T.Text
  , price     :: !Double
  , quantity  :: !Int
  , buysell   :: !TradeDirection
  , bymarket  :: !Bool
  , brokerRef :: !T.Text
  , unfilled  :: !UnfilledAction
  , usecredit :: !Bool
  , nosplit   :: !Bool
  } deriving (Show, Eq, Ord)

instance TransaqCommand CommandNewOrder where
  toXml CommandNewOrder {..} =
    T.pack . showElement $ unode "command" ([strAttr "id" "neworder"],
      [ unode "security" security
      , unode "client" $ T.unpack client
      , unode "union" $ T.unpack unionCode
      , unode "price" $ show price
      , unode "quantity" $ show quantity
      , unode "buysell" buysell
      , unode "brokerref" $ T.unpack brokerRef
      , unode "unfillled" unfilled
      ]
      ++ boolToList "bymarket" bymarket
      ++ boolToList "usecredit" usecredit
      ++ boolToList "nosplit" nosplit)
    where
      boolToList n True  = [unode n ("" :: String)]
      boolToList _ False = []

newtype CommandCancelOrder =
  CommandCancelOrder
  {
    transactionId :: Integer
  } deriving (Show, Eq, Ord)

instance TransaqCommand CommandCancelOrder where
  toXml CommandCancelOrder{..} =
    T.pack . showElement $ unode "command" ([strAttr "id" "cancelOrder"],
      [ unode "transactionid" (show transactionId)])

newtype CommandGetSecuritiesInfo =
  CommandGetSecuritiesInfo
  {
    securities :: [SecurityId]
  } deriving (Show, Eq, Ord)

instance TransaqCommand CommandGetSecuritiesInfo where
  toXml CommandGetSecuritiesInfo{..} =
    T.pack . showElement $ unode "command" ([strAttr "id" "get_securities_info"],
      fmap (unode "security") securities)

data CommandChangePass =
  CommandChangePass
  {
    cOldPass :: !T.Text
  , cNewPass :: !T.Text
  } deriving (Show, Eq)

instance TransaqCommand CommandChangePass where
  toXml CommandChangePass{..} =
    T.pack . showElement $ unode "command"
      [strAttr "id" "change_pass",
       strAttr "oldpass" $ T.unpack cOldPass,
       strAttr "newpass" $ T.unpack cNewPass]

data ResponseResult =
    ResponseSuccess (Maybe Int64)
  | ResponseFailure T.Text
  deriving (Show, Eq, Ord)

instance TransaqResponseC ResponseResult where
  fromXml root =
    if qName (elName root) == "result"
      then
        if findAttr (blank_name {qName = "success"}) root == Just "true"
          then Just $ ResponseSuccess (findAttr (uname "transactionid") root >>= readMaybe)
          else Just . ResponseFailure . T.pack . concatMap cdData . onlyText . elContent $ root
      else Nothing


data Candle =
  Candle
  {
    cTimestamp    :: !UTCTime
  , cOpen         :: !Double
  , cHigh         :: !Double
  , cLow          :: !Double
  , cClose        :: !Double
  , cVolume       :: !Int
  , cOpenInterest :: !Int
  } deriving (Show, Eq, Ord)

data ResponseCandlesStatus =
    StatusEndOfHistory
  | StatusDone
  | StatusPending
  | StatusUnavaliable
  deriving (Show, Eq, Ord)

data ResponseCandles =
  ResponseCandles
  {
    cPeriodId :: !Int
  , cStatus   :: !ResponseCandlesStatus
  , cSecurity :: !SecurityId
  , cCandles  :: ![Candle]
  } deriving (Show, Eq, Ord)

uname :: String -> QName
uname x = blank_name {qName = x}

childContent :: String -> Element -> Maybe String
childContent tag el = strContent <$> findChild (uname tag) el

instance TransaqResponseC ResponseCandles where
  fromXml root = do
    !periodId <- findAttr (uname "period") root >>= readMaybe
    !status <- findAttr (uname "status") root >>= readMaybe >>= parseStatus
    !board <- T.pack <$> findAttr (uname "board") root
    !seccode <- T.pack <$> findAttr (uname "seccode") root
    let !candles = mapMaybe parseCandle . elChildren $ root
    return ResponseCandles
      {
        cPeriodId = periodId
      , cStatus = status
      , cSecurity = SecurityId board seccode
      , cCandles = candles
      }
    where
      parseStatus :: Int -> Maybe ResponseCandlesStatus
      parseStatus intStatus =
        case intStatus of
          0 -> Just StatusEndOfHistory
          1 -> Just StatusDone
          2 -> Just StatusPending
          3 -> Just StatusUnavaliable
          _ -> Nothing
      parseCandle element = do
        !timestamp <- findAttr (uname "date") element >>= parseTimestamp . T.pack
        !open <- findAttr (uname "open") element >>= readMaybe
        !high <- findAttr (uname "high") element >>= readMaybe
        !low <- findAttr (uname "low") element >>= readMaybe
        !close <- findAttr (uname "close") element >>= readMaybe
        !volume <- findAttr (uname "volume") element >>= readMaybe
        let !openInterest = fromMaybe 0 $ findAttr (uname "oi") element >>= readMaybe
        return Candle
          {
            cTimestamp = timestamp
          , cOpen = open
          , cHigh = high
          , cLow = low
          , cClose = close
          , cVolume = volume
          , cOpenInterest = openInterest
          }

data ConnectionState =
    Connected
  | Disconnected
  | Error T.Text
  deriving (Show, Eq, Ord)

data ResponseServerStatus =
  ResponseServerStatus
  {
    serverId       :: !(Maybe Int)
  , state          :: !ConnectionState
  , recover        :: !(Maybe Bool)
  , serverTimezone :: !(Maybe T.Text)
  , systemVersion  :: !(Maybe Int)
  , build          :: !(Maybe Int)
  } deriving (Show, Eq, Ord)

instance TransaqResponseC ResponseServerStatus where
  fromXml root = do
    let !serverId = findAttr (uname "id") root >>= readMaybe
    !connectedStr <- findAttr (uname "connected") root
    !state <- case connectedStr of
      "true"  -> pure Connected
      "false" -> pure Disconnected
      "error" -> pure $ Error (T.pack $ strContent root)
      _       -> pure Disconnected
    let !recover =
          case findAttr (uname "recover") root of
            Just "true" -> pure True
            _           -> pure False
    let !serverTimezone = T.pack <$> findAttr (uname "server_tz") root
    let !systemVersion = findAttr (uname "sys_ver") root >>= readMaybe
    let !build = findAttr (uname "build") root >>= readMaybe
    pure $ ResponseServerStatus {..}

data MarketInfo =
  MarketInfo
  { marketId   :: !Int
  , marketName :: !T.Text
  } deriving (Show, Eq, Ord)

newtype ResponseMarkets = ResponseMarkets [MarketInfo]
  deriving (Show, Eq, Ord)

instance TransaqResponseC ResponseMarkets where
  fromXml root = do
    !markets <- mapM parseMarketInfo $ elChildren root
    pure . ResponseMarkets . catMaybes $ markets
    where
      parseMarketInfo tag =
        if (qName . elName) tag == "market"
        then do
          !marketId <- findAttr (uname "id") tag >>= readMaybe
          let !marketName = T.pack $ strContent tag
          pure $ Just $ MarketInfo {..}
        else pure Nothing

data ClientData =
  ClientData
  {
    cClientId :: !T.Text
  , cType     :: !T.Text
  , cCurrency :: !T.Text
  , cMarket   :: !T.Text
  , cUnion    :: !T.Text
  , cForts    :: !(Maybe T.Text)
  } deriving (Show, Eq, Ord)

newtype ResponseClient = ResponseClient ClientData
  deriving (Show, Eq, Ord)

instance TransaqResponseC ResponseClient where
  fromXml root = do
    if (qName . elName) root == "client"
    then do
      !cClientId <- T.pack <$> findAttr (uname "id") root
      !cType <- T.pack <$> childContent "type" root
      !cCurrency <- T.pack <$> childContent "currency" root
      !cMarket <- T.pack <$> childContent "market" root
      !cUnion <- T.pack <$> childContent "union" root
      let !cForts = T.pack <$> childContent "forts_acc" root
      Just $ ResponseClient $ ClientData {..}
    else Nothing

data CandleKind =
  CandleKind
  {
    kCandleKindId :: !Int
  , kPeriod       :: !Int
  , kName         :: !T.Text
  } deriving (Show, Eq, Ord)

newtype ResponseCandleKinds = ResponseCandleKinds [CandleKind]
  deriving (Show, Eq, Ord)


instance TransaqResponseC ResponseCandleKinds where
  fromXml root = do
    !kinds <- mapM parseCandleKind $ elChildren root
    pure . ResponseCandleKinds . catMaybes $ kinds
    where
      parseCandleKind tag =
        if (qName . elName) tag == "kind"
        then do
          !kCandleKindId <- childContent "id" tag >>= readMaybe
          !kPeriod <- childContent "period" tag >>= readMaybe
          !kName <- T.pack <$> childContent "name" tag
          pure . Just $ CandleKind {..}
        else pure Nothing

data Security =
  Security
  {
    sSecId      :: !Int
  , sActive     :: !Bool
  , sSeccode    :: !T.Text
  , sInstrClass :: !T.Text
  , sBoard      :: !T.Text
  , sMarket     :: !T.Text
  , sCurrency   :: !T.Text
  , sShortName  :: !T.Text
  , sDecimals   :: !Int
  , sMinStep    :: !Double
  , sLotSize    :: !Int
  , sLotDivider :: !Int
  , sPointCost  :: !Double
  , sSecType    :: !T.Text
  } deriving (Show, Eq, Ord)

newtype ResponseSecurities =
  ResponseSecurities [Security]
  deriving (Show, Eq, Ord)

instance TransaqResponseC ResponseSecurities where
  fromXml root = do
    securities <- mapM parseSecurity $ elChildren root
    pure . ResponseSecurities . catMaybes $ securities
    where
      parseSecurity tag =
        if (qName . elName) tag == "security"
        then do
          !sSecId <- findAttr (uname "secid") tag >>= readMaybe
          !sActive <- findAttr (uname "active") tag >>= parseBool
          !sSeccode <- T.pack <$> childContent "seccode" tag
          !sInstrClass <- T.pack <$> childContent "instrclass" tag
          !sBoard <- T.pack <$> childContent "board" tag
          !sMarket <- T.pack <$> childContent "market" tag
          let !sCurrency = fromMaybe "" $ T.pack <$> childContent "currency" tag
          !sShortName <- T.pack <$> childContent "shortname" tag
          !sDecimals <- childContent "decimals" tag >>= readMaybe
          !sMinStep <- childContent "minstep" tag >>= readMaybe
          !sLotSize <- childContent "lotsize" tag >>= readMaybe
          !sLotDivider <- childContent "lotdivider" tag >>= readMaybe
          !sPointCost <- childContent "point_cost" tag >>= readMaybe
          !sSecType <- T.pack <$> childContent "sectype" tag
          pure . Just $ Security {..}
        else
          pure Nothing

      parseBool "true"  = Just True
      parseBool "false" = Just False
      parseBool _       = Nothing


data ResponseSecInfo =
  ResponseSecInfo
  {
    secId         :: !Int
  , secName       :: !T.Text
  , secCode       :: !T.Text
  , market        :: !Int
  , pname         :: !T.Text
  , clearingPrice :: !Double
  , minprice      :: !Double
  , maxprice      :: !Double
  , pointCost     :: !Double
  } deriving (Show, Eq, Ord)


instance TransaqResponseC ResponseSecInfo where
  fromXml tag = do
    secId <- findAttr (uname "secid") tag >>= readMaybe
    secName <- T.pack <$> childContent "secname" tag
    secCode <- T.pack <$> childContent "seccode" tag
    market <- childContent "market" tag >>= readMaybe
    pname <- T.pack <$> childContent "pname" tag
    clearingPrice <- childContent "clearing_price" tag >>= readMaybe
    minprice <- childContent "minprice" tag >>= readMaybe
    maxprice <- childContent "maxprice" tag >>= readMaybe
    pointCost <- childContent "point_cost" tag >>= readMaybe
    pure ResponseSecInfo {..}

data Quotation =
  Quotation
  {
    qSecId         :: !Int
  , qBoard         :: !T.Text
  , qSeccode       :: !T.Text
  , qOpen          :: !Double
  , qWaprice       :: !Double
  , qBidDepth      :: !Int
  , qBidDepthT     :: !Int
  , qNumBids       :: !Int
  , qOfferDepth    :: !Int
  , qOfferDepthT   :: !Int
  , qBid           :: !Double
  , qOffer         :: !Double
  , qNumOffers     :: !Int
  , qNumTrades     :: !Int
  , qVolToday      :: !Int
  , qOpenPositions :: !Int
  , qLastPrice     :: !Double
  , qQuantity      :: !Int
  , qTimestamp     :: !UTCTime
  , qValToday      :: !Double
  } deriving (Show, Eq, Ord)

newtype ResponseQuotations =
  ResponseQuotations [Quotation]
  deriving (Show, Eq, Ord)

instance TransaqResponseC ResponseQuotations where
  fromXml root = do
    quotations <- mapM parseQuotation $ elChildren root
    pure . ResponseQuotations . catMaybes $ quotations
    where
      parseQuotation tag = do
        !qSecId <- findAttr (uname "secid") tag >>= readMaybe
        !qBoard <- T.pack <$> childContent "board" tag
        !qSeccode <- T.pack <$> childContent "seccode" tag
        !qOpen <- childContent "open" tag >>= readMaybe
        !qWaprice <- childContent "waprice" tag >>= readMaybe
        !qBidDepth <- childContent "biddepth" tag >>= readMaybe
        !qBidDepthT <- childContent "biddeptht" tag >>= readMaybe
        !qNumBids <- childContent "numbids" tag >>= readMaybe
        !qBid <- childContent "bid" tag >>= readMaybe
        !qOfferDepth <- childContent "offerdepth" tag >>= readMaybe
        !qOfferDepthT <- childContent "offerdeptht" tag >>= readMaybe
        !qNumOffers <- childContent "numoffers" tag >>= readMaybe
        !qOffer <- childContent "offer" tag >>= readMaybe
        !qNumTrades <- childContent "numtrades" tag >>= readMaybe
        !qVolToday <- childContent "voltoday" tag >>= readMaybe
        !qOpenPositions <- childContent "openpositions" tag >>= readMaybe
        !qLastPrice <- childContent "last" tag >>= readMaybe
        !qQuantity <- childContent "quantity" tag >>= readMaybe
        !qTimestamp <- childContent "time" tag >>= (parseTimestamp . T.pack)
        !qValToday <- childContent "valToday" tag >>= readMaybe
        pure $ Just Quotation {..}

data TradingPeriod =
    PeriodOpen
  | PeriodNormal
  | PeriodClose
  | PeriodUnknown
  deriving (Show, Eq, Ord)

data AllTradesTrade =
  AllTradesTrade
  {
    attSecId        :: !Int
  , attSecCode      :: !T.Text
  , attTradeNo      :: !Int64
  , attTimestamp    :: !UTCTime
  , attBoard        :: !T.Text
  , attPrice        :: !Double
  , attQuantity     :: !Int
  , attBuysell      :: !TradeDirection
  , attOpenInterest :: !Int
  , attPeriod       :: !TradingPeriod
  } deriving (Show, Eq, Ord)

newtype ResponseAllTrades =
  ResponseAllTrades [AllTradesTrade]
  deriving (Show, Eq, Ord)

parseTradeDirection :: T.Text -> Maybe TradeDirection
parseTradeDirection t =
  case t of
    "B" -> Just Buy
    "S" -> Just Sell
    _   -> Nothing

instance TransaqResponseC ResponseAllTrades where
  fromXml root = do
    alltrades <- mapM parseAllTrade $ elChildren root
    pure . ResponseAllTrades . catMaybes $ alltrades
    where
      parseAllTrade tag = do
        !attSecId <- findAttr (uname "secid") tag >>= readMaybe
        !attSecCode <- T.pack <$> childContent "seccode" tag
        !attTradeNo <- childContent "tradeno" tag >>= readMaybe
        !attTimestamp <- T.pack <$> childContent "time" tag >>= parseTimestamp
        !attBoard <- T.pack <$> childContent "board" tag
        !attPrice <- childContent "price" tag >>= readMaybe
        !attQuantity <- childContent "quantity" tag >>= readMaybe
        !attBuysell <- T.pack <$> childContent "buysell" tag >>= parseTradeDirection
        let !attOpenInterest = fromMaybe 0 $ childContent "openinterest" tag >>= readMaybe
        let !attPeriod = fromMaybe PeriodUnknown $ childContent "period" tag >>= parseTradingPeriod
        pure . Just $ AllTradesTrade {..}

      parseTradingPeriod :: String -> Maybe TradingPeriod
      parseTradingPeriod "O" = Just PeriodOpen
      parseTradingPeriod "N" = Just PeriodNormal
      parseTradingPeriod "C" = Just PeriodClose
      parseTradingPeriod _   = Nothing


data Quote =
  Quote
  {
    secId   :: !Int
  , board   :: !T.Text
  , secCode :: !T.Text
  , price   :: !Double
  , source  :: T.Text
  , yield   :: !Int
  , buy     :: !Int
  , sell    :: !Int
  } deriving (Show, Eq, Ord)

newtype ResponseQuotes =
  ResponseQuotes [Quote]
  deriving (Show, Eq, Ord)

instance TransaqResponseC ResponseQuotes where
  fromXml root = do
    quotes <- mapM parseQuote $ elChildren root
    pure . ResponseQuotes . catMaybes $ quotes
    where
      parseQuote tag = do
        !secId <- findAttr (uname "secid") tag >>= readMaybe
        !secCode <- T.pack <$> childContent "seccode" tag
        !board <- T.pack <$> childContent "board" tag
        !price <- childContent "price" tag >>= readMaybe
        !source <- T.pack <$> childContent "source" tag
        !yield <- childContent "yield" tag >>= readMaybe
        !buy <- childContent "buy" tag >>= readMaybe
        !sell <- childContent "sell" tag >>= readMaybe
        return . Just $ Quote {..}

data OrderStatus =
    OrderActive
  | OrderCancelled
  | OrderDenied
  | OrderDisabled
  | OrderExpired
  | OrderFailed
  | OrderForwarding
  | OrderInactive
  | OrderMatched
  | OrderRefused
  | OrderRejected
  | OrderRemoved
  | OrderWait
  | OrderWatching
  deriving (Show, Eq, Ord)

data OrderNotification =
  OrderNotification
  {
    oTransactionId :: !Int
  , oOrderNo       :: !Int64
  , oSecId         :: !Int
  , oBoard         :: !T.Text
  , oSecCode       :: !T.Text
  , oClient        :: !T.Text
  , oUnion         :: !T.Text
  , oStatus        :: !OrderStatus
  , oBuysell       :: !TradeDirection
  , oTimestamp     :: !UTCTime
  , oBrokerRef     :: !T.Text
  , oBalance       :: !Int
  , oPrice         :: !Double
  , oQuantity      :: !Int
  , oResult        :: !T.Text
  } deriving (Show, Eq, Ord)

newtype ResponseOrders =
  ResponseOrders [OrderNotification]
  deriving (Show, Eq, Ord)

instance TransaqResponseC ResponseOrders where
  fromXml root = do
    quotes <- mapM parseOrder $ elChildren root
    pure . ResponseOrders . catMaybes $ quotes
    where
      parseOrder tag = do
        !oTransactionId <- findAttr (uname "transactionid") tag >>= readMaybe
        !oOrderNo <- childContent "orderno" tag >>= readMaybe
        !oSecId <- childContent "secid" tag >>= readMaybe
        !oBoard <- T.pack <$> childContent "board" tag
        !oSecCode <- T.pack <$> childContent "seccode" tag
        !oClient <- T.pack <$> childContent "client" tag
        !oUnion <- T.pack <$> childContent "union" tag
        !oStatus <- childContent "status" tag >>= parseStatus
        !oBuysell <- childContent "buysell" tag >>= parseTradeDirection . T.pack
        !oTimestamp <- childContent "time" tag >>= parseTimestamp . T.pack
        !oBrokerRef <- T.pack <$> childContent "brokerref" tag
        !oBalance <- childContent "balance" tag >>= readMaybe
        !oPrice <- childContent "price" tag >>= readMaybe
        !oQuantity <- childContent "quantity" tag >>= readMaybe
        !oResult <- T.pack <$> childContent "result" tag
        return . Just $ OrderNotification {..}
      parseStatus "active"     = Just OrderActive
      parseStatus "cancelled"  = Just OrderCancelled
      parseStatus "denied"     = Just OrderDenied
      parseStatus "disabled"   = Just OrderDisabled
      parseStatus "expired"    = Just OrderExpired
      parseStatus "failed"     = Just OrderFailed
      parseStatus "forwarding" = Just OrderForwarding
      parseStatus "inactive"   = Just OrderInactive
      parseStatus "matched"    = Just OrderMatched
      parseStatus "refused"    = Just OrderRefused
      parseStatus "rejected"   = Just OrderRejected
      parseStatus "removed"    = Just OrderRemoved
      parseStatus "wait"       = Just OrderWait
      parseStatus "watching"   = Just OrderWatching
      parseStatus _            = Nothing

data TradeNotification =
  TradeNotification
  {
    tSecId     :: !Int
  , tTradeNo   :: !Int64
  , tOrderNo   :: !Int64
  , tBoard     :: !T.Text
  , tSecCode   :: !T.Text
  , tClient    :: !T.Text
  , tUnion     :: !T.Text
  , tBuysell   :: !TradeDirection
  , tTimestamp :: !UTCTime
  , tValue     :: !Double
  , tComission :: !Double
  , tQuantity  :: !Int
  , tPrice     :: !Double
  } deriving (Show, Eq, Ord)

newtype ResponseTrades =
  ResponseTrades [TradeNotification]
  deriving (Show, Eq, Ord)

instance TransaqResponseC ResponseTrades where
  fromXml root = do
    quotes <- mapM parseTrade $ elChildren root
    pure . ResponseTrades . catMaybes $ quotes
    where
      parseTrade tag = do
        !tSecId <- childContent "secid" tag >>= readMaybe
        !tTradeNo <- childContent "tradeno" tag >>= readMaybe
        !tOrderNo <- childContent "orderno" tag >>= readMaybe
        !tBoard <- T.pack <$> childContent "board" tag
        !tSecCode <- T.pack <$> childContent "seccode" tag
        !tClient <- T.pack <$> childContent "client" tag
        !tUnion <- T.pack <$> childContent "union" tag
        !tBuysell <- childContent "buysell" tag >>= parseTradeDirection . T.pack
        !tTimestamp <- childContent "time" tag >>= parseTimestamp . T.pack
        !tValue <- childContent "value" tag >>= readMaybe
        !tComission <- childContent "comission" tag >>= readMaybe
        !tQuantity <- childContent "quantity" tag >>= readMaybe
        !tPrice <- childContent "price" tag >>= readMaybe
        pure . Just $ TradeNotification {..}

data Tick =
  Tick
  {
    secId        :: !Int
  , tradeNo      :: !Int64
  , timestamp    :: !UTCTime
  , price        :: !Double
  , quantity     :: !Int
  , period       :: !TradingPeriod
  , buySell      :: !TradeDirection
  , openInterest :: !Int
  , board        :: !T.Text
  , secCode      :: !T.Text
  } deriving (Show, Eq, Ord)

newtype ResponseTicks =
  ResponseTicks [Tick]
  deriving (Show, Eq, Ord)

data TransaqResponse =
    TransaqResponseResult ResponseResult
  | TransaqResponseCandles ResponseCandles
  | TransaqResponseClient ResponseClient
  | TransaqResponseServerStatus ResponseServerStatus
  | TransaqResponseMarkets ResponseMarkets
  | TransaqResponseCandleKinds ResponseCandleKinds
  | TransaqResponseSecurities ResponseSecurities
  | TransaqResponseSecInfo ResponseSecInfo
  | TransaqResponseQuotations ResponseQuotations
  | TransaqResponseAllTrades ResponseAllTrades
  | TransaqResponseQuotes ResponseQuotes
  | TransaqResponseOrders ResponseOrders
  | TransaqResponseTrades ResponseTrades
  deriving (Show, Eq, Ord)

instance TransaqResponseC TransaqResponse where
  fromXml root = case qName . elName $ root of
    "result"        -> TransaqResponseResult <$> fromXml root
    "error"         -> TransaqResponseResult <$> fromXml root
    "client"        -> TransaqResponseClient <$> fromXml root
    "candles"       -> TransaqResponseCandles <$> fromXml root
    "server_status" -> TransaqResponseServerStatus <$> fromXml root
    "markets"       -> TransaqResponseMarkets <$> fromXml root
    "candlekinds"   -> TransaqResponseCandleKinds <$> fromXml root
    "securities"    -> TransaqResponseSecurities <$> fromXml root
    "sec_info"      -> TransaqResponseSecInfo <$> fromXml root
    "quotations"    -> TransaqResponseQuotations <$> fromXml root
    "alltrades"     -> TransaqResponseAllTrades <$> fromXml root
    "quotes"        -> TransaqResponseQuotes <$> fromXml root
    "orders"        -> TransaqResponseOrders <$> fromXml root
    "trades"        -> TransaqResponseTrades <$> fromXml root
    _               -> Nothing