6 changed files with 562 additions and 59 deletions
@ -1,9 +0,0 @@
@@ -1,9 +0,0 @@
|
||||
|
||||
import Test.Tasty |
||||
|
||||
main :: IO () |
||||
main = defaultMain $ testGroup "Tests" [unitTests] |
||||
|
||||
unitTests :: TestTree |
||||
unitTests = testGroup "Unit Tests" |
||||
[ Test.RoboCom.Indicators.unitTests ] |
||||
@ -1,12 +1,510 @@
@@ -1,12 +1,510 @@
|
||||
{-# 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" |
||||
[ |
||||
test |
||||
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 |
||||
|
||||
Loading…
Reference in new issue