|
|
|
@ -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 |
|
|
|
|