9 changed files with 1858 additions and 58 deletions
@ -0,0 +1,143 @@
@@ -0,0 +1,143 @@
|
||||
{-# LANGUAGE OverloadedRecordDot #-} |
||||
{-# LANGUAGE QuasiQuotes #-} |
||||
|
||||
import Criterion.Main |
||||
import qualified Data.ByteString as BS |
||||
import Data.Text.Encoding |
||||
import Data.Text.Encoding.Error |
||||
import Safe |
||||
import Text.RawString.QQ |
||||
import Text.XML.Light.Input (parseXMLDoc) |
||||
import Transaq |
||||
import Transaq.Parsing |
||||
|
||||
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 |
||||
|
||||
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 |
||||
|
||||
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" /> |
||||
<candle date="05.01.2024 12:30:01.123" open="40.3" high="44" low="40" close="41.8" volume="1234" /> |
||||
<candle date="05.01.2024 12:30:02.123" open="40.3" high="44" low="40" close="41.8" volume="1234" /> |
||||
<candle date="05.01.2024 12:30:03.123" open="40.3" high="44" low="40" close="41.8" volume="1234" /> |
||||
</candles> |
||||
|] :: BS.ByteString |
||||
|
||||
validServerStatus = |
||||
[r|<server_status id="22" connected="true" recover="true" server_tz="TZ" sys_ver="42" build="51" /> |] :: BS.ByteString |
||||
|
||||
validMarkets = |
||||
[r| |
||||
<markets> |
||||
<market id="1">FOO</market> |
||||
<market id="2">BAR</market> |
||||
</markets> |
||||
|] :: BS.ByteString |
||||
|
||||
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 |
||||
|
||||
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 |
||||
|
||||
parseDom :: BS.ByteString -> Maybe TransaqResponse |
||||
parseDom d = parseXMLDoc (decodeUtf8With lenientDecode d) >>= fromXml |
||||
|
||||
parseSax :: BS.ByteString -> Maybe TransaqResponse |
||||
parseSax = headMay . parseTransaqResponses |
||||
|
||||
main = defaultMain |
||||
[ |
||||
bgroup "DOM" |
||||
[ |
||||
bench "<client>" $ whnf parseDom validClient |
||||
, bench "<candlekinds>" $ whnf parseDom validCandleKinds |
||||
, bench "<candles>" $ whnf parseDom validCandles |
||||
, bench "<server_status>" $ whnf parseDom validServerStatus |
||||
, bench "<markets>" $ whnf parseDom validMarkets |
||||
, bench "<securities>" $ whnf parseDom validSecurities |
||||
, bench "<alltrades>" $ whnf parseDom validAllTrades |
||||
] |
||||
, bgroup "SAX" |
||||
[ |
||||
bench "<client>" $ whnf parseSax validClient |
||||
, bench "<candlekinds>" $ whnf parseSax validCandleKinds |
||||
, bench "<candles>" $ whnf parseSax validCandles |
||||
, bench "<server_status>" $ whnf parseSax validServerStatus |
||||
, bench "<markets>" $ whnf parseSax validMarkets |
||||
, bench "<securities>" $ whnf parseSax validSecurities |
||||
, bench "<alltrades>" $ whnf parseSax validAllTrades |
||||
] |
||||
] |
||||
@ -0,0 +1,520 @@
@@ -0,0 +1,520 @@
|
||||
{-# 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 |
||||
Loading…
Reference in new issue