Browse Source

Test: build

master
Denis Tereshkin 3 years ago
parent
commit
dc6702765f
  1. 4
      robocom-zero.cabal
  2. 2
      src/ATrade/Driver/Junction/QuoteThread.hs
  3. 13
      test/Test/BarAggregator.hs
  4. 19
      test/Test/Driver/Junction/QuoteThread.hs

4
robocom-zero.cabal

@ -99,6 +99,8 @@ test-suite robots-test
, tasty-golden , tasty-golden
, tasty-hedgehog , tasty-hedgehog
, tasty-hspec , tasty-hspec
, tasty-quickcheck
, tasty-smallcheck
, quickcheck-text , quickcheck-text
, quickcheck-instances , quickcheck-instances
, containers , containers
@ -107,6 +109,8 @@ test-suite robots-test
, zeromq4-haskell-zap , zeromq4-haskell-zap
, BoundedChan , BoundedChan
, mtl , mtl
, co-log-core
, co-log
ghc-options: -threaded -rtsopts -with-rtsopts=-N ghc-options: -threaded -rtsopts -with-rtsopts=-N
default-language: Haskell2010 default-language: Haskell2010
other-modules: Test.RoboCom.Indicators other-modules: Test.RoboCom.Indicators

2
src/ATrade/Driver/Junction/QuoteThread.hs

@ -93,7 +93,7 @@ data QuoteThreadEnv =
startQuoteThread :: (MonadIO m, startQuoteThread :: (MonadIO m,
MonadIO m1, MonadIO m1,
WithLog DownloaderEnv Message m1, WithLog env Message m1,
HistoryProvider m1, HistoryProvider m1,
TickerInfoProvider m1) => TickerInfoProvider m1) =>
IORef Bars -> IORef Bars ->

13
test/Test/BarAggregator.hs

@ -33,11 +33,10 @@ unitTests = testGroup "BarAggregator" [
] ]
properties = testGroup "BarAggregator" [ properties = testGroup "BarAggregator" [
prop_allTicksInOneBar, prop_allTicksInOneBar
prop_ticksInTwoBars
] ]
secParams = InstrumentParameters 1 0.01 secParams = InstrumentParameters "TEST_TICKER" 1 0.01
testUnknownBarSeries :: TestTree testUnknownBarSeries :: TestTree
testUnknownBarSeries = testCase "Tick with unknown ticker id" $ do testUnknownBarSeries = testCase "Tick with unknown ticker id" $ do
@ -125,10 +124,10 @@ prop_allTicksInOneBar = testProperty "All ticks in one bar" $ property $ do
where where
genTick :: T.Text -> UTCTime -> Int -> Gen Tick genTick :: T.Text -> UTCTime -> Int -> Gen Tick
genTick tickerId base tf = do genTick tickerId base tf = do
difftime <- fromRational . toRational . picosecondsToDiffTime <$> choose (0, truncate 1e12 * fromIntegral tf) difftime <- fromRational . toRational . picosecondsToDiffTime <$> Gen.integral (Range.linear 0 (truncate 1e12 * fromIntegral tf))
val <- arbitrary val <- fromIntegral <$> Gen.int (Range.linear 1 1000000)
vol <- arbitrary `suchThat` (> 0) vol <- Gen.integral (Range.linear 1 1000000)
return $ Tick tickerId LastTradePrice (difftime `addUTCTime` baseTime) val vol return $ Tick tickerId LastTradePrice (difftime `addUTCTime` baseTime) (fromDouble $ val / 1000) vol
mkAggregator tickerId tf = mkAggregatorFromBars (M.singleton tickerId (BarSeries tickerId (BarTimeframe tf) [] secParams)) [(0, 86400)] mkAggregator tickerId tf = mkAggregatorFromBars (M.singleton tickerId (BarSeries tickerId (BarTimeframe tf) [] secParams)) [(0, 86400)]
currentBar tickerId agg = headMay =<< (bsBars <$> M.lookup tickerId (bars agg)) currentBar tickerId agg = headMay =<< (bsBars <$> M.lookup tickerId (bars agg))

19
test/Test/Driver/Junction/QuoteThread.hs

@ -1,5 +1,6 @@
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE TypeSynonymInstances #-}
@ -16,6 +17,7 @@ import Test.Tasty.SmallCheck as SC
import ATrade.Driver.Junction.QuoteThread (addSubscription, import ATrade.Driver.Junction.QuoteThread (addSubscription,
startQuoteThread, startQuoteThread,
stopQuoteThread) stopQuoteThread)
import ATrade.Logging (Message)
import ATrade.Quotes.HistoryProvider (HistoryProvider (..)) import ATrade.Quotes.HistoryProvider (HistoryProvider (..))
import ATrade.Quotes.TickerInfoProvider (TickerInfoProvider (..)) import ATrade.Quotes.TickerInfoProvider (TickerInfoProvider (..))
import ATrade.QuoteSource.Client (QuoteData (QDBar)) import ATrade.QuoteSource.Client (QuoteData (QDBar))
@ -26,23 +28,21 @@ import ATrade.RoboCom.Types (BarSeries (bsBars),
BarSeriesId (BarSeriesId), BarSeriesId (BarSeriesId),
InstrumentParameters (InstrumentParameters)) InstrumentParameters (InstrumentParameters))
import ATrade.Types import ATrade.Types
import Colog.Core (LogAction (..))
import Colog.Core.Class (HasLog (..))
import Control.Concurrent (forkIO, threadDelay) import Control.Concurrent (forkIO, threadDelay)
import Control.Concurrent.BoundedChan (newBoundedChan, readChan, import Control.Concurrent.BoundedChan (newBoundedChan, readChan,
writeChan) writeChan)
import Control.Exception (bracket) import Control.Exception (bracket)
import Control.Monad (forever) import Control.Monad (forever)
import Control.Monad.Reader import Control.Monad.Reader
import Data.IORef (newIORef, readIORef) import Data.IORef (IORef, newIORef, readIORef)
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import qualified Data.Text as T import qualified Data.Text as T
import Data.Time (UTCTime (UTCTime), import Data.Time (UTCTime (UTCTime),
fromGregorian) fromGregorian)
import System.IO (BufferMode (LineBuffering), import System.IO (BufferMode (LineBuffering),
hSetBuffering, stderr) hSetBuffering, stderr)
import System.Log.Formatter
import System.Log.Handler (setFormatter)
import System.Log.Handler.Simple
import System.Log.Logger
import System.ZMQ4 (withContext) import System.ZMQ4 (withContext)
import Test.Mock.HistoryProvider (MockHistoryProvider, import Test.Mock.HistoryProvider (MockHistoryProvider,
mkMockHistoryProvider, mkMockHistoryProvider,
@ -70,13 +70,16 @@ instance TickerInfoProvider TestM where
tip <- asks tickerInfoProvider tip <- asks tickerInfoProvider
liftIO $ mockGetInstrumentParameters tip tickers liftIO $ mockGetInstrumentParameters tip tickers
instance HasLog TestEnv Message TestM where
getLogAction env = LogAction $ \msg -> return ()
qsEndpoint = "inproc://qs" qsEndpoint = "inproc://qs"
mockHistoryProvider = mkMockHistoryProvider $ M.fromList [(BarSeriesId "FOO" (BarTimeframe 3600), bars)] mockHistoryProvider = mkMockHistoryProvider $ M.fromList [(BarSeriesId "FOO" (BarTimeframe 3600), bars)]
where where
bars = [] bars = []
mockTickerInfoProvider = mkMockTickerInfoProvider $ M.fromList [("FOO", InstrumentParameters 10 0.1)] mockTickerInfoProvider = mkMockTickerInfoProvider $ M.fromList [("FOO", InstrumentParameters "FOO" 10 0.1)]
unitTests = testGroup "Driver.Junction.QuoteThread" [ unitTests = testGroup "Driver.Junction.QuoteThread" [
testSubscription testSubscription
@ -85,12 +88,14 @@ unitTests = testGroup "Driver.Junction.QuoteThread" [
testSubscription :: TestTree testSubscription :: TestTree
testSubscription = testCase "Subscription" $ withContext $ \ctx -> do testSubscription = testCase "Subscription" $ withContext $ \ctx -> do
barsRef <- newIORef M.empty barsRef <- newIORef M.empty
tiRef <- newIORef M.empty
serverChan <- newBoundedChan 2000 serverChan <- newBoundedChan 2000
let clientSecurityParams = defaultClientSecurityParams
bracket bracket
(startQuoteSourceServer serverChan ctx qsEndpoint defaultServerSecurityParams) (startQuoteSourceServer serverChan ctx qsEndpoint defaultServerSecurityParams)
stopQuoteSourceServer $ \_ -> stopQuoteSourceServer $ \_ ->
bracket bracket
(startQuoteThread barsRef ctx qsEndpoint Nothing Nothing (`runReaderT` (TestEnv mockHistoryProvider mockTickerInfoProvider))) (startQuoteThread barsRef tiRef ctx qsEndpoint clientSecurityParams (`runReaderT` (TestEnv mockHistoryProvider mockTickerInfoProvider)) (LogAction $ \_ -> return ()))
stopQuoteThread $ \qt -> do stopQuoteThread $ \qt -> do
chan <- newBoundedChan 2000 chan <- newBoundedChan 2000

Loading…
Cancel
Save