You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

521 lines
17 KiB

2 years ago
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE QuasiQuotes #-}
module Test.Transaq.Parsing
(
unitTests
) where
import Control.Monad.State (execState)
import Data.AEq ((~==))
import qualified Data.ByteString as BS
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (assertBool, assertFailure, testCase,
(@=?))
import Text.RawString.QQ
import Transaq (AllTradesTradeB (..), CandleB (..),
CandleKind, CandleKindB (..),
ClientDataB (..), ConnectionState (..),
MarketInfoB (..), OrderNotificationB (..),
OrderStatus (..), QuotationB (..),
QuoteB (..), ResponseAllTrades (..),
ResponseCandleKinds (..),
ResponseCandlesB (..),
ResponseCandlesStatus (..),
ResponseClient (..), ResponseMarkets (..),
ResponseOrders (..),
ResponseQuotations (..),
ResponseQuotes (..), ResponseResult (..),
ResponseSecInfoB (..),
ResponseSecurities (..),
ResponseServerStatusB (..),
ResponseTrades (..), SecurityB (..),
SecurityId (..), TradeDirection (..),
TradeNotificationB (..),
TradingPeriod (..), TransaqResponse (..))
import Transaq.Parsing
import Xeno.SAX (process)
unitTests :: TestTree
unitTests = testGroup "Parsing"
[
unitTestsStreaming
]
unitTestsStreaming :: TestTree
unitTestsStreaming = testGroup "Parsing via xeno-sax"
[
testParseResultStreaming
, testParseClientStreaming
, testParseCandleKindsStreaming
, testParseCandlesStreaming
, testParseServerStatusStreaming
, testParseMarketsStreaming
, testParseSecuritiesStreaming
, testParseSecInfoStreaming
, testParseQuotationsStreaming
, testParseAllTradesStreaming
, testParseQuotesStreaming
, testParseOrdersStreaming
, testParseTradesStreaming
]
testParseResultStreaming :: TestTree
testParseResultStreaming = testGroup "Parsing result"
[
testParseResultSuccess
, testParseResultSuccessWithTransactionId
, testParseResultFailure
]
where
resultSuccess = [r|<result success="true" />|] :: BS.ByteString
testParseResultSuccess = testCase "Parse success result" $ do
[TransaqResponseResult (ResponseSuccess Nothing)] @=?
parseTransaqResponses resultSuccess
resultSuccessWithTransactionId = [r|<result success="true" transactionid="12" />|] :: BS.ByteString
testParseResultSuccessWithTransactionId = testCase "Parse success result with transaction ID" $ do
[TransaqResponseResult (ResponseSuccess (Just 12))] @=?
parseTransaqResponses resultSuccessWithTransactionId
resultFailure = [r|<result success="false" />|] :: BS.ByteString
testParseResultFailure = testCase "Parse failure result" $ do
[TransaqResponseResult (ResponseFailure "")] @=?
parseTransaqResponses resultFailure
testParseClientStreaming :: TestTree
testParseClientStreaming = testCase "Parse ResponseClient - valid XML" $ do
case parseTransaqResponses validClient of
[TransaqResponseClient (ResponseClient clientData)] -> do
"FOO" @=? cClientId clientData
"TYPE" @=? cType clientData
"CURRENCY" @=? cCurrency clientData
"MARKET" @=? cMarket clientData
"UNION" @=? cUnion clientData
Just "FORTS_ACC" @=? cForts clientData
_ -> assertFailure "Invalid <client> parse"
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>
|] :: BS.ByteString
testParseCandleKindsStreaming :: TestTree
testParseCandleKindsStreaming = testCase "Parse CandleKind - valid XML" $ do
let candleKinds = parseTransaqResponses validCandleKinds
let [TransaqResponseCandleKinds (ResponseCandleKinds [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>
|] :: BS.ByteString
testParseCandlesStreaming :: TestTree
testParseCandlesStreaming = testCase "Parse Candles - valid XML" $ do
let [TransaqResponseCandles responseCandles] = parseTransaqResponses validCandles
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>
|] :: BS.ByteString
testParseServerStatusStreaming :: TestTree
testParseServerStatusStreaming = testCase "Parse ServerStatus - valid XML" $ do
let [TransaqResponseServerStatus serverStatus] = parseTransaqResponses validServerStatus
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" /> |] :: BS.ByteString
testParseMarketsStreaming :: TestTree
testParseMarketsStreaming = testCase "Parse ResponseMarkets - valid XML" $ do
let markets = parseTransaqResponses validMarkets
let [TransaqResponseMarkets (ResponseMarkets [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>
|] :: BS.ByteString
testParseSecuritiesStreaming :: TestTree
testParseSecuritiesStreaming = testCase "Parse ResponseSecurities - valid XML" $ do
let [TransaqResponseSecurities (ResponseSecurities securities)] = parseTransaqResponses validSecurities
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>
|] :: BS.ByteString
testParseSecInfoStreaming :: TestTree
testParseSecInfoStreaming = testCase "Parse ResponseSecInfo - valid XML" $ do
let [TransaqResponseSecInfo sec] = parseTransaqResponses validSecInfo
"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>
|] :: BS.ByteString
testParseQuotationsStreaming :: TestTree
testParseQuotationsStreaming = testCase "Parse ResponseQuotations - valid XML (full)" $ do
let [TransaqResponseQuotations (ResponseQuotations quotations)] = parseTransaqResponses validQuotations
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>
|] :: BS.ByteString
testParseAllTradesStreaming :: TestTree
testParseAllTradesStreaming = testCase "Parse ResponseAllTrades - valid XML (full)" $ do
let [TransaqResponseAllTrades (ResponseAllTrades trades)] = parseTransaqResponses validAllTrades
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>
|] :: BS.ByteString
testParseQuotesStreaming :: TestTree
testParseQuotesStreaming = testCase "Parse ResponseQuotes - valid XML (full)" $ do
let [TransaqResponseQuotes (ResponseQuotes quotes)] = parseTransaqResponses validQuotes
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>
|] :: BS.ByteString
testParseOrdersStreaming :: TestTree
testParseOrdersStreaming = testCase "Parse ResponseOrders - valid XML (full)" $ do
let [TransaqResponseOrders (ResponseOrders orders)] = parseTransaqResponses validOrders
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>
|] :: BS.ByteString
testParseTradesStreaming :: TestTree
testParseTradesStreaming = testCase "Parse ResponseTrades - valid XML (full)" $ do
let [TransaqResponseTrades (ResponseTrades trades)] = parseTransaqResponses validTrades
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>
|] :: BS.ByteString