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.
520 lines
17 KiB
520 lines
17 KiB
{-# 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
|
|
|