robocom-zero/test/Test/Driver/Junction/QuoteThread.hs

{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# 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.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           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                         (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.Log.Formatter
import           System.Log.Handler                 (setFormatter)
import           System.Log.Handler.Simple
import           System.Log.Logger
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

qsEndpoint = "inproc://qs"

mockHistoryProvider = mkMockHistoryProvider $ M.fromList [(BarSeriesId "FOO" (BarTimeframe 3600), bars)]
  where
    bars = []

mockTickerInfoProvider = mkMockTickerInfoProvider $ M.fromList [("FOO", InstrumentParameters 10 0.1)]

unitTests = testGroup "Driver.Junction.QuoteThread" [
  testSubscription
  ]

testSubscription :: TestTree
testSubscription = testCase "Subscription" $ withContext $ \ctx -> do
  barsRef <- newIORef M.empty
  serverChan <- newBoundedChan 2000
  bracket
    (startQuoteSourceServer serverChan ctx qsEndpoint defaultServerSecurityParams)
    stopQuoteSourceServer $ \_ ->
      bracket
        (startQuoteThread barsRef ctx qsEndpoint Nothing Nothing (`runReaderT` (TestEnv mockHistoryProvider mockTickerInfoProvider)))

        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
          }