transaq-connector/test/Test/Transaq.hs

{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE QuasiQuotes         #-}

module Test.Transaq
(
  unitTests
  ) where

import           Data.AEq             ((~==))
import qualified Data.Text            as T
import           Test.Tasty
import           Test.Tasty.HUnit     (assertBool, testCase, (@=?))
import           Text.RawString.QQ
import           Text.XML.Light.Input (parseXMLDoc)
import           Transaq

unitTests :: TestTree
unitTests = testGroup "Parsing"
  [
    testParseResult
  , testParseCandles
  , testParseClient
  , testParseClientWithoutForts
  , testParseServerStatus
  , testParseMarkets
  , testParseCandleKinds
  , testParseSecurities
  , testParseSecInfo
  , testParseQuotations
  , testParseAllTrades
  , testParseQuotes
  , testParseOrders
  , testParseTrades
  ]

testParseResult :: TestTree
testParseResult = testGroup "Parsing result"
  [
    testParseResultSuccess
  , testParseResultSuccessWithTransactionId
  , testParseResultFailure
  ]
  where
    resultSuccess = [r|<result success="true />"|] :: T.Text
    testParseResultSuccess = testCase "Parse success result" $ do
      let (Just (ResponseSuccess Nothing)) = (parseXMLDoc resultSuccess >>= fromXml :: Maybe ResponseResult)
      return ()
    resultSuccessWithTransactionId = [r|<result success="true" transactionid="12"|] :: T.Text
    testParseResultSuccessWithTransactionId = testCase "Parse success result with transaction ID" $ do
      let (Just (ResponseSuccess (Just 12))) = (parseXMLDoc resultSuccessWithTransactionId >>= fromXml :: Maybe ResponseResult)
      return ()
    resultFailure = [r|<result success="false />"|] :: T.Text
    testParseResultFailure = testCase "Parse success result" $ do
      let (Just (ResponseFailure _)) = (parseXMLDoc resultFailure >>= fromXml :: Maybe ResponseResult)
      return ()

testParseCandles :: TestTree
testParseCandles = testCase "Parse ResponseCandles - valid XML" $ do
  let (Just responseCandles) = (parseXMLDoc validCandles >>= fromXml :: Maybe ResponseCandles)
  SecurityId "foo" "bar" @=? cSecurity responseCandles
  1 @=? cPeriodId responseCandles
  StatusEndOfHistory @=? cStatus responseCandles
  1 @=? (length . cCandles) responseCandles
  let candle = head . cCandles $ responseCandles
  assertBool "Candle open mismatch" (41.3 ~== cOpen candle)
  assertBool "Candle high mismatch" (42 ~== cHigh candle)
  assertBool "Candle low mismatch" (40 ~== cLow candle)
  assertBool "Candle close mismatch" (41.6 ~== cClose candle)
  1234 @=? cVolume candle
  78 @=? cOpenInterest candle
  where
    validCandles =
      [r|
        <candles secid="12" period="1" status="0" board="foo" seccode="bar">
          <candle date="05.01.2024 12:30:00.123" open="41.3" high="42" low="40" close="41.6" volume="1234" oi="78" />
        </candles>
        |] :: T.Text

testParseClient :: TestTree
testParseClient = testCase "Parse ResponseClient - valid XML" $ do
  let (Just (ResponseClient clientData)) = (parseXMLDoc validClient >>= fromXml :: Maybe ResponseClient)
  "FOO" @=? cClientId clientData
  "TYPE" @=? cType clientData
  "CURRENCY" @=? cCurrency clientData
  "MARKET" @=? cMarket clientData
  "UNION" @=? cUnion clientData
  Just "FORTS_ACC" @=? cForts clientData
  where
    validClient =
      [r|
        <client id="FOO">
          <type>TYPE</type>
          <currency>CURRENCY</currency>
          <market>MARKET</market>
          <union>UNION</union>
          <forts_acc>FORTS_ACC</forts_acc>
        </client>
        |] :: T.Text

testParseClientWithoutForts :: TestTree
testParseClientWithoutForts = testCase "Parse ResponseClient - valid XML (without FORTS account ID)" $ do
  let (Just (ResponseClient clientData)) = (parseXMLDoc validClient >>= fromXml :: Maybe ResponseClient)
  "FOO" @=? cClientId clientData
  "TYPE" @=? cType clientData
  "CURRENCY" @=? cCurrency clientData
  "MARKET" @=? cMarket clientData
  "UNION" @=? cUnion clientData
  Nothing @=? cForts clientData
  where
    validClient =
      [r|
        <client id="FOO">
          <type>TYPE</type>
          <currency>CURRENCY</currency>
          <market>MARKET</market>
          <union>UNION</union>
        </client>
        |] :: T.Text

testParseServerStatus :: TestTree
testParseServerStatus = testCase "Parse ResponseServerStatus - valid XML (full)" $ do
  let (Just serverStatus) = (parseXMLDoc validServerStatus >>= fromXml :: Maybe ResponseServerStatus)
  Just 22 @=? serverId serverStatus
  Connected @=? state serverStatus
  Just True @=? recover serverStatus
  Just "TZ" @=? serverTimezone serverStatus
  Just 42 @=? systemVersion serverStatus
  Just 51 @=? build serverStatus
  where
    validServerStatus =
      [r|<server_status id="22" connected="true" recover="true" server_tz="TZ" sys_ver="42" build="51" /> |] :: T.Text

testParseMarkets :: TestTree
testParseMarkets = testCase "Parse ResponseMarkets - valid XML" $ do
  let (Just (ResponseMarkets markets)) = (parseXMLDoc validMarkets >>= fromXml :: Maybe ResponseMarkets)
  2 @=? length markets

  let [foo, bar] = markets

  1 @=? marketId foo
  "FOO" @=? marketName foo

  2 @=? marketId bar
  "BAR" @=? marketName bar
  where
    validMarkets =
      [r|
        <markets>
          <market id="1">FOO</market>
          <market id="2">BAR</market>
        </markets>
        |] :: T.Text

testParseCandleKinds :: TestTree
testParseCandleKinds = testCase "Parse ResponseCandleKinds - valid XML" $ do
  let (Just (ResponseCandleKinds candleKinds)) = (parseXMLDoc validCandleKinds >>= fromXml :: Maybe ResponseCandleKinds)

  2 @=? length candleKinds

  let [m10, m15] = candleKinds

  4 @=? kCandleKindId m10
  600 @=? kPeriod m10
  "M10" @=? kName m10

  5 @=? kCandleKindId m15
  900 @=? kPeriod m15
  "M15" @=? kName m15
  where
    validCandleKinds =
      [r|
        <candlekinds>
          <kind>
            <id>4</id>
            <period>600</period>
            <name>M10</name>
          </kind>
          <kind>
            <id>5</id>
            <period>900</period>
            <name>M15</name>
          </kind>
        </candlekinds>
        |] :: T.Text

testParseSecurities :: TestTree
testParseSecurities = testCase "Parse ResponseSecurities - valid XML" $ do
  let (Just (ResponseSecurities securities)) = (parseXMLDoc validSecurities >>= fromXml :: Maybe ResponseSecurities)
  1 @=? length securities

  let sec = head securities
  "SECCODE" @=? sSeccode sec
  "CLASS" @=? sInstrClass sec
  "BOARD" @=? sBoard sec
  "15" @=? sMarket sec
  "CURRENCY" @=? sCurrency sec
  "SHORTNAME" @=? sShortName sec
  3 @=? sDecimals sec
  assertBool "Minstep is not valid" (0.1 ~== sMinStep sec)
  10 @=? sLotSize sec
  1 @=? sLotDivider sec
  assertBool "Point cost is not valid" (6.28 ~== sPointCost sec)
  "SECTYPE" @=? sSecType sec
  where
    validSecurities =
      [r|
        <securities>
          <security secid="1" active="true">
            <seccode>SECCODE</seccode>
            <instrclass>CLASS</instrclass>
            <board>BOARD</board>
            <market>15</market>
            <currency>CURRENCY</currency>
            <shortname>SHORTNAME</shortname>
            <decimals>3</decimals>
            <minstep>0.1</minstep>
            <lotsize>10</lotsize>
            <lotdivider>1</lotdivider>
            <point_cost>6.28</point_cost>
            <optmask usecredit="yes" bymarket="no" nosplit="yes" fok="no" ioc="no" />
            <sectype>SECTYPE</sectype>
            <sec_tz>SECTZ</sec_tz>
            <quotestype>1</quotestype>
            <MIC>FOO</MIC>
            <currencyid>CURRENCYID</currencyid>
          </security>
        </securities>
        |] :: T.Text

testParseSecInfo :: TestTree
testParseSecInfo = testCase "Parse ResponseSecInfo - valid XML" $ do
  let (Just sec) = (parseXMLDoc validSecInfo >>= fromXml :: Maybe ResponseSecInfo)

  "SECNAME" @=? secName sec
  "SECCODE" @=? sec.secCode
  44 @=? market sec
  "PNAME" @=? pname sec
  assertBool "Clearing price is not valid" (12.34 ~== clearingPrice sec)
  assertBool "Min price is not valid" (10 ~== minPrice sec)
  assertBool "Max price is not valid" (20 ~== maxPrice sec)
  assertBool "Point cost is not valid" (6.28 ~== pointCost sec)
  where
    validSecInfo =
      [r|
        <sec_info secid="4">
          <secname>SECNAME</secname>
          <seccode>SECCODE</seccode>
          <market>44</market>
          <pname>PNAME</pname>
          <clearing_price>12.34</clearing_price>
          <minprice>10</minprice>
          <maxprice>20</maxprice>
          <point_cost>6.28</point_cost>
        </sec_info>
        |] :: T.Text

testParseQuotations :: TestTree
testParseQuotations = testCase "Parse ResponseQuotations - valid XML (full)" $ do
  let (Just (ResponseQuotations quotations)) = (parseXMLDoc validQuotations >>= fromXml :: Maybe ResponseQuotations)
  1 @=? length quotations

  let q = head quotations

  1 @=? qSecId q
  "BOARD" @=? qBoard q
  "SECCODE" @=? qSeccode q

  let (Just open') = qOpen q
  assertBool "Open is not valid" (12.34 ~== open')

  let (Just waprice') = qWaprice q
  assertBool "WA price is not valid" (13.8 ~== waprice')

  Just 40 @=? qBidDepth q
  Just 140 @=? qBidDepthT q
  Just 10 @=? qNumBids q

  let (Just bid') = qBid q
  assertBool "Bid is not valid" (11.01 ~== bid')

  Just 50 @=? qOfferDepth q
  Just 150 @=? qOfferDepthT q
  Just 15 @=? qNumOffers q

  let (Just offer') = qOffer q
  assertBool "Offer is not valid" (11.05 ~== offer')

  Just 1000 @=? qNumTrades q
  Just 50000 @=? qVolToday q
  Just 1000 @=? qOpenPositions q

  let (Just last') = qLastPrice q
  assertBool "Last price is not valid" (11.03 ~== last')

  Just 8 @=? qQuantity q

  -- TODO check time

  let (Just valtoday') = qValToday q
  assertBool "Val today is not valid" (12345678 ~== valtoday')
  where
    validQuotations =
      [r|
        <quotations>
          <quotation secid="1">
            <board>BOARD</board>
            <seccode>SECCODE</seccode>
            <open>12.34</open>
            <waprice>13.8</waprice>
            <biddepth>40</biddepth>
            <biddeptht>140</biddeptht>
            <numbids>10</numbids>
            <bid>11.01</bid>
            <offerdepth>50</offerdepth>
            <offerdeptht>150</offerdeptht>
            <numoffers>15</numoffers>
            <offer>11.05</offer>
            <numtrades>1000</numtrades>
            <voltoday>50000</voltoday>
            <openpositions>1000</openpositions>
            <last>11.03</last>
            <quantity>8</quantity>
            <time>05.01.2024 19:34:18.234</time>
            <valtoday>12345678</valtoday>
          </quotation>
        </quotations>
        |] :: T.Text

testParseAllTrades :: TestTree
testParseAllTrades = testCase "Parse ResponseAllTrades - valid XML (full)" $ do
  let (Just (ResponseAllTrades trades)) = (parseXMLDoc validAllTrades >>= fromXml :: Maybe ResponseAllTrades)
  2 @=? length trades

  let [t1, t2] = trades

  1 @=? attSecId t1
  "SEC1" @=? attSecCode t1
  14 @=? attTradeNo t1
  -- TODO check time
  "BOARD" @=? attBoard t1
  assertBool "Price is not valid" (12.34 ~== attPrice t1)
  10 @=? attQuantity t1
  Buy @=? attBuysell t1
  100 @=? attOpenInterest t1
  PeriodNormal @=? attPeriod t1

  2 @=? attSecId t2
  "SEC2" @=? attSecCode t2
  15 @=? attTradeNo t2
  -- TODO check time
  "BOARD" @=? attBoard t2
  assertBool "Price is not valid" (12.35 ~== attPrice t2)
  11 @=? attQuantity t2
  Sell @=? attBuysell t2
  200 @=? attOpenInterest t2
  PeriodNormal @=? attPeriod t2
  where
    validAllTrades =
      [r|
        <alltrades>
          <trade secid="1">
            <seccode>SEC1</seccode>
            <tradeno>14</tradeno>
            <time>05.01.2024 19:34:18.234</time>
            <board>BOARD</board>
            <price>12.34</price>
            <quantity>10</quantity>
            <buysell>B</buysell>
            <openinterest>100</openinterest>
            <period>N</period>
          </trade>
          <trade secid="2">
            <seccode>SEC2</seccode>
            <tradeno>15</tradeno>
            <time>05.01.2024 19:34:19.234</time>
            <board>BOARD</board>
            <price>12.35</price>
            <quantity>11</quantity>
            <buysell>S</buysell>
            <openinterest>200</openinterest>
            <period>N</period>
          </trade>
        </alltrades>
        |] :: T.Text

testParseQuotes :: TestTree
testParseQuotes = testCase "Parse ResponseQuotes - valid XML (full)" $ do
  let (Just (ResponseQuotes quotes)) = (parseXMLDoc validQuotes >>= fromXml :: Maybe ResponseQuotes)
  2 @=? length quotes

  let [q1, q2] = quotes

  1 @=? q1.secId
  "BOARD" @=? q1.board
  assertBool "Price is not valid" (12.34 ~== q1.price)
  Just "SOURCE" @=? q1.source
  Just 10 @=? q1.buy
  Nothing @=? q1.sell

  2 @=? q2.secId
  "BOARD" @=? q2.board
  assertBool "Price is not valid" (12.35 ~== q2.price)
  Just "SOURCE" @=? q2.source
  Nothing @=? q2.buy
  Just 11 @=? q2.sell
  where
    validQuotes =
      [r|
        <quotes>
          <quote secid="1">
            <board>BOARD</board>
            <seccode>SEC1</seccode>
            <price>12.34</price>
            <source>SOURCE</source>
            <buy>10</buy>
          </quote>
          <quote secid="2">
            <board>BOARD</board>
            <seccode>SEC2</seccode>
            <price>12.35</price>
            <source>SOURCE</source>
            <sell>11</sell>
          </quote>
        </quotes>
        |] :: T.Text

testParseOrders :: TestTree
testParseOrders = testCase "Parse ResponseOrders - valid XML (full)" $ do
  let (Just (ResponseOrders orders)) = (parseXMLDoc validOrders >>= fromXml :: Maybe ResponseOrders)
  1 @=? length orders

  let order = head orders

  12 @=? oTransactionId order
  42 @=? oOrderNo order
  1 @=? oSecId order
  "BOARD" @=? oBoard order
  "SEC1" @=? oSecCode order
  Just "CLIENT" @=? oClient order
  Just "UNION" @=? oUnion order
  Just OrderActive @=? oStatus order
  Just Buy @=? oBuysell order

  let Just price' = oPrice order
  assertBool "Price is not valid" (12.34 ~== price')

  Just 12 @=? oQuantity order

  where
    validOrders =
      [r|
        <orders>
          <order transactionid="12">
            <orderno>42</orderno>
            <secid>1</secid>
            <board>BOARD</board>
            <seccode>SEC1</seccode>
            <client>CLIENT</client>
            <union>UNION</union>
            <status>active</status>
            <buysell>B</buysell>
            <time>05.01.2024 19:34:19.234</time>
            <price>12.34</price>
            <quantity>12</quantity>
          </order>
        </orders>
        |] :: T.Text

testParseTrades :: TestTree
testParseTrades = testCase "Parse ResponseTrades - valid XML (full)" $ do
  let (Just (ResponseTrades trades)) = (parseXMLDoc validTrades >>= fromXml :: Maybe ResponseTrades)
  1 @=? length trades

  let trade = head trades

  1 @=? tSecId trade
  12 @=? tTradeNo trade
  42 @=? tOrderNo trade
  "BOARD" @=? tBoard trade
  "SEC1" @=? tSecCode trade
  "CLIENT" @=? tClient trade
  "UNION" @=? tUnion trade
  Buy @=? tBuysell trade
  -- TODO check time

  True @=? (123.4 ~== tValue trade)
  True @=? (0.5 ~== tComission trade)
  10 @=? tQuantity trade
  True @=? (12.34 ~== tPrice trade)
  where
    validTrades =
      [r|
        <trades>
          <trade>
            <secid>1</secid>
            <tradeno>12</tradeno>
            <orderno>42</orderno>
            <board>BOARD</board>
            <seccode>SEC1</seccode>
            <client>CLIENT</client>
            <union>UNION</union>
            <buysell>B</buysell>
            <time>05.01.2024 19:34:19.234</time>
            <value>123.40</value>
            <comission>0.5</comission>
            <quantity>10</quantity>
            <price>12.34</price>
          </trade>
        </trades>
        |] :: T.Text