{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeSynonymInstances #-} module Test.Driver.Junction.QuoteThread ( unitTests ) where import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.QuickCheck as QC import Test.Tasty.SmallCheck as SC import ATrade.Driver.Junction.QuoteThread (addSubscription, startQuoteThread, stopQuoteThread) import ATrade.Logging (Message) import ATrade.Quotes.HistoryProvider (HistoryProvider (..)) import ATrade.Quotes.TickerInfoProvider (TickerInfoProvider (..)) import ATrade.QuoteSource.Client (QuoteData (QDBar)) import ATrade.QuoteSource.Server (QuoteSourceServerData (..), startQuoteSourceServer, stopQuoteSourceServer) import ATrade.RoboCom.Types (BarSeries (bsBars), BarSeriesId (BarSeriesId), InstrumentParameters (InstrumentParameters)) import ATrade.Types import Colog.Core (LogAction (..)) import Colog.Core.Class (HasLog (..)) import Control.Concurrent (forkIO, threadDelay) import Control.Concurrent.BoundedChan (newBoundedChan, readChan, writeChan) import Control.Exception (bracket) import Control.Monad (forever) import Control.Monad.Reader import Data.IORef (IORef, newIORef, readIORef) import qualified Data.Map.Strict as M import qualified Data.Text as T import Data.Time (UTCTime (UTCTime), fromGregorian) import System.IO (BufferMode (LineBuffering), hSetBuffering, stderr) import System.ZMQ4 (withContext) import Test.Mock.HistoryProvider (MockHistoryProvider, mkMockHistoryProvider, mockGetHistory) import Test.Mock.TickerInfoProvider (MockTickerInfoProvider, mkMockTickerInfoProvider, mockGetInstrumentParameters) data TestEnv = TestEnv { historyProvider :: MockHistoryProvider, tickerInfoProvider :: MockTickerInfoProvider } type TestM = ReaderT TestEnv IO instance HistoryProvider TestM where getHistory tid tf from to = do hp <- asks historyProvider liftIO $ mockGetHistory hp tid tf from to instance TickerInfoProvider TestM where getInstrumentParameters tickers = do tip <- asks tickerInfoProvider liftIO $ mockGetInstrumentParameters tip tickers instance HasLog TestEnv Message TestM where getLogAction env = LogAction $ \msg -> return () qsEndpoint = "inproc://qs" mockHistoryProvider = mkMockHistoryProvider $ M.fromList [(BarSeriesId "FOO" (BarTimeframe 3600), bars)] where bars = [] mockTickerInfoProvider = mkMockTickerInfoProvider $ M.fromList [("FOO", InstrumentParameters "FOO" 10 0.1)] unitTests = testGroup "Driver.Junction.QuoteThread" [ testSubscription ] testSubscription :: TestTree testSubscription = testCase "Subscription" $ withContext $ \ctx -> do barsRef <- newIORef M.empty tiRef <- newIORef M.empty serverChan <- newBoundedChan 2000 let clientSecurityParams = defaultClientSecurityParams bracket (startQuoteSourceServer serverChan ctx qsEndpoint defaultServerSecurityParams) stopQuoteSourceServer $ \_ -> bracket (startQuoteThread barsRef tiRef ctx qsEndpoint clientSecurityParams (`runReaderT` (TestEnv mockHistoryProvider mockTickerInfoProvider)) (LogAction $ \_ -> return ())) stopQuoteThread $ \qt -> do chan <- newBoundedChan 2000 addSubscription qt "FOO" (BarTimeframe 3600) chan forkIO $ forever $ threadDelay 50000 >> writeChan serverChan (QSSBar (BarTimeframe 3600, bar)) clientData <- readChan chan assertEqual "Invalid client data" clientData (QDBar (BarTimeframe 3600, bar)) bars <- readIORef barsRef case M.lookup (BarSeriesId "FOO" (BarTimeframe 3600)) bars of Just series -> assertBool "Length should be >= 1" $ (not . null . bsBars) series Nothing -> assertFailure "Bar Series should be present" where bar = Bar { barSecurity="FOO", barTimestamp=UTCTime (fromGregorian 2021 11 20) 7200, barOpen=10, barHigh=12, barLow=9, barClose=11, barVolume=100 }