WIP: QuoteThread mostly works

robocom-zero.cabal

@@ -25,16 +25,18 @@ library
                      , ATrade.Quotes.Finam
                      , ATrade.Quotes.QHP
                      , ATrade.Quotes.QTIS
-                     , ATrade.Driver.Real
+--                     , ATrade.Driver.Real
-                     , ATrade.Driver.Backtest
+--                     , ATrade.Driver.Backtest
                      , ATrade.Driver.Junction
                      , ATrade.Driver.Junction.Types
-                     , ATrade.Driver.Junction.OrderRouter
                      , ATrade.BarAggregator
                      , ATrade.RoboCom
+                     , ATrade.Driver.Junction.QuoteThread
+                     , ATrade.Quotes.HistoryProvider
+                     , ATrade.Quotes.TickerInfoProvider
   other-modules:       Paths_robocom_zero
   build-depends:       base >= 4.7 && < 5
-                     , libatrade >= 0.9.0.0 && < 0.10.0.0
+                     , libatrade >= 0.10.0.0 && < 0.11.0.0
                      , text
                      , text-icu
                      , errors
@@ -53,7 +55,9 @@ library
                      , binary
                      , binary-ieee754
                      , zeromq4-haskell
+                     , zeromq4-haskell-zap
                      , unordered-containers
+                     , hashable
                      , th-printf
                      , BoundedChan
                      , monad-loops
@@ -73,11 +77,14 @@ library
                      , unliftio
                      , monad-logger
                      , bimap
+                     , stm
+                     , async
+                     , dhall
                      
   default-language:    Haskell2010
   other-modules:       ATrade.Exceptions
-                     , ATrade.Driver.Real.BrokerClientThread
+--                     , ATrade.Driver.Real.BrokerClientThread
-                     , ATrade.Driver.Real.QuoteSourceThread
+--                     , ATrade.Driver.Real.QuoteSourceThread
                      , ATrade.Driver.Types
 
 test-suite robots-test
@@ -99,13 +106,19 @@ test-suite robots-test
                      , quickcheck-instances
                      , containers
                      , safe
+                     , zeromq4-haskell
+                     , zeromq4-haskell-zap
+                     , BoundedChan
+                     , hslogger
   ghc-options:         -threaded -rtsopts -with-rtsopts=-N
   default-language:    Haskell2010
   other-modules:     Test.RoboCom.Indicators
-                   , Test.RoboCom.Positions
                    , Test.RoboCom.Utils
+                   , Test.Driver.Junction.QuoteThread
                    , Test.BarAggregator
                    , ArbitraryInstances
+                   , Test.Mock.HistoryProvider
+                   , Test.Mock.TickerInfoProvider
 
 source-repository head
   type:     git

src/ATrade/BarAggregator.hs

@@ -79,12 +79,12 @@ handleTick tick = runState $ do
       case M.lookup (security tick) mybars of
         Just series -> case bsBars series of
           (b:bs) -> do
-            let currentBn = barNumber (barTimestamp b) (tfSeconds $ bsTimeframe series)
+            let currentBn = barNumber (barTimestamp b) (fromIntegral . unBarTimeframe $ bsTimeframe series)
             case datatype tick of
               LastTradePrice ->
                 if volume tick > 0
                   then
-                    if currentBn == barNumber (timestamp tick) (tfSeconds $ bsTimeframe series)
+                    if currentBn == barNumber (timestamp tick) (fromIntegral . unBarTimeframe $ bsTimeframe series)
                       then do
                         lBars %= M.insert (security tick) series { bsBars = updateBar b tick : bs }
                         return Nothing
@@ -94,7 +94,7 @@ handleTick tick = runState $ do
                   else
                     return Nothing
               _ ->
-                if currentBn == barNumber (timestamp tick) (tfSeconds $ bsTimeframe series)
+                if currentBn == barNumber (timestamp tick) (fromIntegral . unBarTimeframe $ bsTimeframe series)
                   then do
                     lBars %= M.insert (security tick) series { bsBars = updateBarTimestamp b tick : bs }
                     return Nothing
@@ -147,8 +147,8 @@ updateTime tick = runState $ do
       case M.lookup (security tick) mybars of
         Just series -> case bsBars series of
           (b:bs) -> do
-            let currentBn = barNumber (barTimestamp b) (tfSeconds $ bsTimeframe series)
+            let currentBn = barNumber (barTimestamp b) (fromIntegral . unBarTimeframe $ bsTimeframe series)
-            let thisBn = barNumber (timestamp tick) (tfSeconds $ bsTimeframe series)
+            let thisBn = barNumber (timestamp tick) (fromIntegral . unBarTimeframe $ bsTimeframe series)
             if
               | currentBn == thisBn -> do
                   lBars %= M.insert (security tick) series { bsBars = updateBarTimestamp b tick : bs }

src/ATrade/Driver/Junction.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE DeriveGeneric         #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE OverloadedStrings     #-}
 
 module ATrade.Driver.Junction
@@ -9,15 +11,29 @@ import           ATrade.Driver.Junction.Types (StrategyDescriptor (..),
                                                 StrategyInstance (..),
                                                 StrategyInstanceDescriptor (..))
 import           ATrade.RoboCom.Types          (Ticker (..))
+import           Control.Concurrent            (forkIO)
+import           Control.Concurrent.Async      (forConcurrently_)
+import           Control.Concurrent.STM        (atomically)
+import           Control.Concurrent.STM.TQueue (newTQueueIO)
+import           Control.Concurrent.STM.TVar   (newTVarIO)
 import           Data.Aeson                    (FromJSON (..), ToJSON (..),
-                                               decode, object, withObject, (.:),
+                                                decode, object, withObject,
-                                               (.=))
+                                                (.:), (.=))
 import qualified Data.ByteString               as B
 import qualified Data.ByteString.Lazy          as BL
 import           Data.IORef
 import qualified Data.Map.Strict               as M
 import           Data.Maybe                    (fromMaybe)
+import           Data.Semigroup                ((<>))
 import qualified Data.Text                     as T
+import           Data.Text.IO                  (readFile)
+import           Dhall                         (FromDhall, auto, input)
+import           GHC.Generics                  (Generic)
+import           Options.Applicative           (Parser, execParser, fullDesc,
+                                                header, help, helper, info,
+                                                long, metavar, progDesc, short,
+                                                strOption, (<**>))
+import           Prelude                       hiding (readFile)
 
 data BigConfig c = BigConfig {
   confTickers  :: [Ticker],
@@ -33,20 +49,51 @@ instance (ToJSON c) => ToJSON (BigConfig c) where
   toJSON conf = object ["tickers" .= confTickers conf,
     "params" .= confStrategy conf ]
 
+data ProgramOptions =
+  ProgramOptions
+  {
+    configPath :: FilePath
+  }
+
+data ProgramConfiguration =
+  ProgramConfiguration
+  {
+    brokerEndpoint        :: T.Text,
+    brokerServerCert      :: Maybe FilePath,
+    brokerClientCert      :: Maybe FilePath,
+    quotesourceEndpoint   :: T.Text,
+    quotesourceServerCert :: Maybe FilePath,
+    quotesourceClientCert :: Maybe FilePath,
+    qhpEndpoint           :: T.Text,
+    qtisEndpoint          :: T.Text,
+    redisSocket           :: T.Text,
+    globalLog             :: FilePath,
+    instances             :: [StrategyInstanceDescriptor]
+  } deriving (Generic, Show)
+
+instance FromDhall ProgramConfiguration
 
 load :: T.Text -> IO (Maybe B.ByteString)
 load = undefined
 
 junctionMain :: M.Map T.Text StrategyDescriptor -> IO ()
 junctionMain descriptors = do
-  parseOptions
+  opts <- parseOptions
-  instanceDescriptors <- undefined
+
-  strategies <- mkStrategies instanceDescriptors
+  cfg <- readFile (configPath opts) >>= input auto
 
-  start strategies
+  bars <- newTVarIO M.empty
+
+  strategies <- mkStrategies (instances cfg)
+
+  start strategies bars
 
   where
-    parseOptions = undefined
+    parseOptions = execParser options
+    options = info (optionsParser <**> helper)
+      (fullDesc <>
+       progDesc "Robocom-zero junction mode driver" <>
+       header "robocom-zero-junction")
 
     mkStrategies :: [StrategyInstanceDescriptor] -> IO [StrategyInstance]
     mkStrategies = mapM mkStrategy
@@ -71,8 +118,13 @@ junctionMain descriptors = do
             _ -> error "Can't read state and config"
         _ -> error $ "Can't find strategy: " ++ T.unpack (strategyId desc)
 
-    start strategy = undefined
+    start strategies bars = undefined
-
-
 
+    optionsParser :: Parser ProgramOptions
+    optionsParser = ProgramOptions
+      <$> strOption
+            (long "config" <>
+             short 'c' <>
+             metavar "FILENAME" <>
+             help "Configuration file path")
 

src/ATrade/Driver/Junction/QuoteThread.hs

@@ -0,0 +1,147 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE LambdaCase    #-}
+
+module ATrade.Driver.Junction.QuoteThread
+ (
+   QuoteThreadHandle,
+   startQuoteThread,
+   stopQuoteThread,
+   addSubscription
+ ) where
+
+import           ATrade.Quotes.HistoryProvider    (HistoryProvider (..))
+import           ATrade.Quotes.TickerInfoProvider (TickerInfoProvider (..))
+import           ATrade.QuoteSource.Client        (QuoteData (QDBar, QDTick),
+                                                   QuoteSourceClientHandle,
+                                                   quoteSourceClientSubscribe,
+                                                   startQuoteSourceClient,
+                                                   stopQuoteSourceClient)
+import           ATrade.RoboCom.Types             (Bar (barSecurity),
+                                                   BarSeries (..),
+                                                   BarSeriesId (BarSeriesId),
+                                                   Bars, InstrumentParameters)
+import           ATrade.Types                     (BarTimeframe (BarTimeframe), ClientSecurityParams (ClientSecurityParams),
+                                                   Tick (security), TickerId)
+import           Control.Concurrent               (ThreadId, forkIO, killThread)
+import           Control.Concurrent.BoundedChan   (BoundedChan, newBoundedChan,
+                                                   readChan, writeChan)
+import           Control.Monad                    (forever)
+import           Control.Monad.Reader             (MonadIO (liftIO),
+                                                   ReaderT (runReaderT), lift)
+import           Control.Monad.Reader.Class       (asks)
+import           Data.Hashable                    (Hashable)
+import qualified Data.HashMap.Strict              as HM
+import           Data.IORef                       (IORef, atomicModifyIORef',
+                                                   newIORef, readIORef)
+import qualified Data.Map.Strict                  as M
+import qualified Data.Text                        as T
+import           Data.Time                        (addUTCTime, getCurrentTime)
+import           GHC.Generics                     (Generic)
+import           System.ZMQ4                      (Context)
+import           System.ZMQ4.ZAP                  (CurveCertificate)
+
+data QuoteSubscription =
+  QuoteSubscription TickerId BarTimeframe
+  deriving (Generic, Eq)
+
+instance Hashable BarTimeframe
+instance Hashable QuoteSubscription
+
+data QuoteThreadHandle = QuoteThreadHandle ThreadId ThreadId QuoteThreadEnv
+
+data QuoteThreadEnv =
+  QuoteThreadEnv
+  {
+    bars        :: IORef Bars,
+    endpoints   :: IORef (HM.HashMap QuoteSubscription [BoundedChan QuoteData]),
+    qsclient    :: QuoteSourceClientHandle,
+    paramsCache :: IORef (M.Map TickerId InstrumentParameters),
+    historyProvider :: HistoryProvider,
+    tickerInfoProvider :: TickerInfoProvider,
+    downloaderChan :: BoundedChan QuoteSubscription
+  }
+
+startQuoteThread :: (MonadIO m) =>
+  IORef Bars ->
+  Context ->
+  T.Text ->
+  Maybe CurveCertificate ->
+  Maybe CurveCertificate ->
+  HistoryProvider ->
+  TickerInfoProvider ->
+  m QuoteThreadHandle
+startQuoteThread barsRef ctx ep clientCert serverCert hp tip = do
+  chan <- liftIO $ newBoundedChan 2000
+  dChan <- liftIO $ newBoundedChan 2000
+  qsc <- liftIO $ startQuoteSourceClient chan [] ctx ep (ClientSecurityParams clientCert serverCert)
+  env <- liftIO $ QuoteThreadEnv barsRef <$> newIORef HM.empty <*> pure qsc <*> newIORef M.empty <*> pure hp <*> pure tip <*> pure dChan
+  tid <- liftIO . forkIO $ quoteThread env chan
+  downloaderTid <- liftIO . forkIO $ downloaderThread env dChan
+  return $ QuoteThreadHandle tid downloaderTid env
+  where
+    downloaderThread env chan = forever $ do
+      QuoteSubscription tickerid tf <- readChan chan
+      paramsMap <- liftIO $ readIORef $ paramsCache env
+      mbParams <- case M.lookup tickerid paramsMap of
+        Nothing -> do
+          paramsList <- liftIO $ getInstrumentParameters (tickerInfoProvider env) [tickerid]
+          case paramsList of
+            (params:_) -> liftIO $ atomicModifyIORef' (paramsCache env) (\m -> (M.insert tickerid params m, Just params))
+            _ -> return Nothing
+        Just params -> return $ Just params
+      barsMap <- readIORef (bars env)
+      case M.lookup (BarSeriesId tickerid tf) barsMap of
+        Just _ -> return () -- already downloaded
+        Nothing -> case mbParams of
+          Just params -> do
+            now <- liftIO getCurrentTime
+            barsData <- liftIO $ getHistory (historyProvider env) tickerid tf ((-86400 * 60) `addUTCTime` now) now
+            let barSeries = BarSeries tickerid tf barsData params
+            atomicModifyIORef' (bars env) (\m -> (M.insert (BarSeriesId tickerid tf) barSeries m, ()))
+          _ -> return () -- TODO log
+
+
+    quoteThread env chan = flip runReaderT env $ forever $ do
+      qssData <- lift $ readChan chan
+      case qssData of
+        QDBar (tf, bar) -> do
+          barsRef' <- asks bars
+          lift $ atomicModifyIORef' barsRef' (\x -> (updateBarsMap x bar tf, ()))
+        _ -> return () -- TODO pass to bar aggregator
+      let key = case qssData of
+                  QDTick tick -> QuoteSubscription (security tick) (BarTimeframe 0)
+                  QDBar (tf, bar) -> QuoteSubscription (barSecurity bar) tf
+      subs <- asks endpoints >>= (lift . readIORef)
+      case HM.lookup key subs of
+        Just clientChannels -> do
+          lift $ mapM_ (`writeChan` qssData) clientChannels
+        Nothing            -> return ()
+
+stopQuoteThread :: (MonadIO m) => QuoteThreadHandle -> m ()
+stopQuoteThread (QuoteThreadHandle tid dtid env) = liftIO $ do
+  killThread tid
+  killThread dtid
+  stopQuoteSourceClient (qsclient env)
+
+addSubscription :: (MonadIO m) => QuoteThreadHandle -> TickerId -> BarTimeframe -> BoundedChan QuoteData -> m ()
+addSubscription (QuoteThreadHandle _ _ env) tid tf chan = liftIO $ do
+  writeChan (downloaderChan env) (QuoteSubscription tid tf)
+  atomicModifyIORef' (endpoints env) (\m -> (doAddSubscription m tid, ()))
+  quoteSourceClientSubscribe (qsclient env) [(tid, BarTimeframe 0)]
+  where
+    doAddSubscription m tickerid =
+      let m1 = HM.alter (\case
+                   Just chans -> Just (chan : chans)
+                   _ -> Just [chan]) (QuoteSubscription tickerid tf) m in
+      HM.alter (\case
+                   Just chans -> Just (chan : chans)
+                   _ -> Just [chan]) (QuoteSubscription tickerid (BarTimeframe 0)) m1
+
+updateBarsMap :: Bars -> Bar -> BarTimeframe -> Bars
+updateBarsMap barsMap bar tf = M.adjust (addToSeries bar) (BarSeriesId (barSecurity bar) tf) barsMap
+
+addToSeries :: Bar -> BarSeries -> BarSeries
+addToSeries bar series = series { bsBars = bar : bsBars series }
+
+
+

src/ATrade/Driver/Junction/Types.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE DeriveGeneric             #-}
+{-# LANGUAGE DuplicateRecordFields     #-}
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE RankNTypes                #-}
 
@@ -12,9 +14,10 @@ module ATrade.Driver.Junction.Types
 import           ATrade.RoboCom.Monad (EventCallback)
 import           ATrade.Types         (BarTimeframe, TickerId)
 import           Data.Aeson           (FromJSON (..), ToJSON (..))
-import qualified Data.ByteString      as B
 import           Data.IORef
 import qualified Data.Text            as T
+import           Dhall                (FromDhall)
+import           GHC.Generics         (Generic)
 
 data StrategyDescriptor =
   forall c s. (FromJSON s, ToJSON s, FromJSON c) =>
@@ -39,9 +42,10 @@ data StrategyInstanceDescriptor =
     strategyName :: T.Text,
     configKey    :: T.Text,
     stateKey     :: T.Text,
-    logPath      :: T.Text,
+    logPath      :: T.Text
-    tickers      :: [TickerConfig]
+  } deriving (Generic, Show)
-  }
+
+instance FromDhall StrategyInstanceDescriptor
 
 data StrategyInstance =
   forall c s. (FromJSON s, ToJSON s, FromJSON c) =>

src/ATrade/Quotes/HistoryProvider.hs

@@ -0,0 +1,14 @@
+
+module ATrade.Quotes.HistoryProvider
+  (
+    HistoryProvider(..)
+  ) where
+
+import           ATrade.RoboCom.Types (Bar)
+import           ATrade.Types         (BarTimeframe, TickerId)
+import           Data.Time            (UTCTime)
+newtype HistoryProvider =
+  HistoryProvider
+ {
+   getHistory :: TickerId -> BarTimeframe -> UTCTime -> UTCTime -> IO [Bar]
+ }

src/ATrade/Quotes/TickerInfoProvider.hs

@@ -0,0 +1,13 @@
+
+module ATrade.Quotes.TickerInfoProvider
+  (
+    TickerInfoProvider(..)
+  ) where
+
+import           ATrade.RoboCom.Types (InstrumentParameters)
+import           ATrade.Types         (TickerId)
+newtype TickerInfoProvider =
+  TickerInfoProvider
+ {
+   getInstrumentParameters :: [TickerId] -> IO [InstrumentParameters]
+ }

src/ATrade/RoboCom/Positions.hs

@@ -145,7 +145,7 @@ modifyPositions f = do
   modifyState (\s -> setPositions s (f pos))
 
 class ParamsHasMainTicker a where
-  mainTicker :: a -> TickerId
+  mainTicker :: a -> BarSeriesId
 
 -- | Helper function. Finds first element in list which satisfies predicate 'p' and if found, applies 'm' to it, leaving other elements intact.
 findAndModify :: (a -> Bool) -> (a -> a) -> [a] -> [a]
@@ -464,7 +464,7 @@ enterAtMarket operationSignalName operation = do
 
 enterAtMarketWithParams :: (StateHasPositions s, ParamsHasMainTicker c, MonadRobot m c s) => T.Text -> Int -> SignalId -> Operation -> m Position
 enterAtMarketWithParams account quantity signalId operation = do
-  tickerId <- mainTicker <$> getConfig
+  tickerId <- bsidTickerId . mainTicker <$> getConfig
   submitOrder $ order tickerId
   newPosition (order tickerId) account tickerId operation quantity 20
   where
@@ -490,7 +490,7 @@ enterAtLimitWithVolume timeToCancel operationSignalName price vol operation = do
 
 enterAtLimitWithParams :: (StateHasPositions s, ParamsHasMainTicker c, MonadRobot m c s) => NominalDiffTime -> T.Text -> Int -> SignalId -> Price -> Operation -> m Position
 enterAtLimitWithParams timeToCancel account quantity signalId price operation = do
-  tickerId <- mainTicker <$> getConfig
+  tickerId <- bsidTickerId . mainTicker <$> getConfig
   enterAtLimitForTickerWithParams tickerId timeToCancel account quantity signalId price operation
 
 enterAtLimitForTickerWithVolume :: (StateHasPositions s, MonadRobot m c s) => TickerId -> NominalDiffTime -> T.Text -> Price -> Int -> Operation -> m Position

src/ATrade/RoboCom/Types.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveGeneric        #-}
 {-# LANGUAGE FlexibleContexts     #-}
 {-# LANGUAGE FlexibleInstances    #-}
 {-# LANGUAGE OverloadedStrings    #-}
@@ -6,12 +7,12 @@
 
 module ATrade.RoboCom.Types (
   Bar(..),
+  BarSeriesId(..),
   BarSeries(..),
-  Timeframe(..),
-  tfSeconds,
   Ticker(..),
   Bars,
-  InstrumentParameters(..)
+  InstrumentParameters(..),
+  bsidTickerId
 ) where
 
 import           ATrade.Types
@@ -20,12 +21,8 @@ import           Data.Aeson.Types
 import qualified Data.HashMap.Strict as HM
 import qualified Data.Map.Strict     as M
 import qualified Data.Text           as T
+import           GHC.Generics        (Generic)
 
-newtype Timeframe =
-  Timeframe Integer deriving (Show, Eq)
-
-tfSeconds :: (Num a) => Timeframe -> a
-tfSeconds (Timeframe s) = fromInteger s
 
 data InstrumentParameters =
   InstrumentParameters {
@@ -36,7 +33,7 @@ data InstrumentParameters =
 data BarSeries =
   BarSeries {
     bsTickerId  :: TickerId,
-    bsTimeframe :: Timeframe,
+    bsTimeframe :: BarTimeframe,
     bsBars      :: [Bar],
     bsParams    :: InstrumentParameters
   } deriving (Show, Eq)
@@ -68,5 +65,11 @@ instance ToJSON Ticker where
     "timeframe" .= timeframeSeconds t,
     "aliases" .= Object (HM.fromList $ fmap (\(x, y) -> (T.pack x, String $ T.pack y)) $ aliases t) ]
 
-type Bars = M.Map TickerId BarSeries
+data BarSeriesId = BarSeriesId TickerId BarTimeframe
+  deriving (Show, Eq, Generic, Ord)
+
+bsidTickerId :: BarSeriesId -> TickerId
+bsidTickerId (BarSeriesId tid _) = tid
+
+type Bars = M.Map BarSeriesId BarSeries
 

src/ATrade/RoboCom/Utils.hs

@@ -20,6 +20,7 @@ import qualified Data.Text          as T
 import           Data.Time.Calendar
 import           Data.Time.Clock
 
+import           Data.Int           (Int64)
 import           Text.Read          hiding (String)
 
 rescaleToDaily :: [Bar] -> [Bar]
@@ -36,13 +37,13 @@ rescaleToDaily (firstBar:restBars) = rescaleToDaily' restBars firstBar
 
 rescaleToDaily [] = []
 
-barEndTime :: Bar -> Integer -> UTCTime
+barEndTime :: Bar -> Int64 -> UTCTime
 barEndTime bar tframe = addUTCTime (fromIntegral $ (1 + barNumber (barTimestamp bar) tframe) * tframe) epoch
 
-barStartTime :: Bar -> Integer -> UTCTime
+barStartTime :: Bar -> Int64 -> UTCTime
 barStartTime bar tframe = addUTCTime (fromIntegral $ barNumber (barTimestamp bar) tframe * tframe) epoch
 
-barNumber :: UTCTime -> Integer -> Integer
+barNumber :: UTCTime -> Int64 -> Int64
 barNumber ts barlen = floor (diffUTCTime ts epoch) `div` barlen
 
 epoch :: UTCTime

test/ArbitraryInstances.hs

@@ -52,7 +52,7 @@ instance Arbitrary OrderPrice where
        | v == 2 -> Limit <$> arbitrary `suchThat` notTooBig
        | v == 3 -> Stop <$> arbitrary `suchThat` notTooBig <*> arbitrary `suchThat` notTooBig
        | v == 4 -> StopMarket <$> arbitrary `suchThat` notTooBig
-       | otherwise -> fail "Invalid case"
+       | otherwise -> error "invalid case"
 
 instance Arbitrary Operation where
   arbitrary = elements [Buy, Sell]

test/Spec.hs

@@ -1,6 +1,6 @@
 import qualified Test.BarAggregator
+import qualified Test.Driver.Junction.QuoteThread
 import qualified Test.RoboCom.Indicators
-import qualified Test.RoboCom.Positions
 import qualified Test.RoboCom.Utils
 
 import           Test.Tasty
@@ -11,9 +11,9 @@ main = defaultMain $ testGroup "Tests" [unitTests, properties]
 unitTests :: TestTree
 unitTests = testGroup "Unit Tests"
   [Test.RoboCom.Indicators.unitTests,
-   Test.RoboCom.Positions.unitTests,
    Test.RoboCom.Utils.unitTests,
-   Test.BarAggregator.unitTests ]
+   Test.BarAggregator.unitTests,
+   Test.Driver.Junction.QuoteThread.unitTests]
 
 properties :: TestTree
 properties = testGroup "Properties"

test/Test/BarAggregator.hs

@@ -29,17 +29,14 @@ unitTests = testGroup "BarAggregator" [
   , testOneTick
   , testTwoTicksInSameBar
   , testTwoTicksInDifferentBars
-  , testOneBar
-  , testTwoBarsInSameBar
-  , testTwoBarsInSameBarLastBar
-  , testNextBarAfterBarClose
-  , testUpdateTime
   ]
 
 properties = testGroup "BarAggregator" [
     prop_allTicksInOneBar
   ]
 
+secParams = InstrumentParameters 1 0.01
+
 testUnknownBarSeries :: TestTree
 testUnknownBarSeries = testCase "Tick with unknown ticker id" $ do
   let agg = BarAggregator M.empty M.empty [(0, 86400)]
@@ -57,7 +54,7 @@ testUnknownBarSeries = testCase "Tick with unknown ticker id" $ do
 
 testOneTick :: TestTree
 testOneTick = testCase "One tick" $ do
-  let series = BarSeries "TEST_TICKER" (Timeframe 60) []
+  let series = BarSeries "TEST_TICKER" (BarTimeframe 60) [] secParams
   let agg = mkAggregatorFromBars (M.fromList [("TEST_TICKER", series)]) [(0, 86400)]
   let (mbar, newagg) = handleTick tick agg
   mbar @?= Nothing
@@ -73,7 +70,7 @@ testOneTick = testCase "One tick" $ do
 
 testTwoTicksInSameBar :: TestTree
 testTwoTicksInSameBar = testCase "Two ticks - same bar" $ do
-  let series = BarSeries "TEST_TICKER" (Timeframe 60) []
+  let series = BarSeries "TEST_TICKER" (BarTimeframe 60) [] secParams
   let agg = mkAggregatorFromBars (M.fromList [("TEST_TICKER", series)]) [(0, 86400)]
   let (mbar, newagg) = handleTick (tick testTimestamp1 12.00) agg
   mbar @?= Nothing
@@ -92,7 +89,7 @@ testTwoTicksInSameBar = testCase "Two ticks - same bar" $ do
 
 testTwoTicksInDifferentBars :: TestTree
 testTwoTicksInDifferentBars = testCase "Two ticks - different bar" $ do
-  let series = BarSeries "TEST_TICKER" (Timeframe 60) []
+  let series = BarSeries "TEST_TICKER" (BarTimeframe 60) [] secParams
   let agg = mkAggregatorFromBars (M.fromList [("TEST_TICKER", series)]) [(0, 86400)]
   let (mbar, newagg) = handleTick (tick testTimestamp1 12.00) agg
   mbar @?= Nothing
@@ -109,120 +106,6 @@ testTwoTicksInDifferentBars = testCase "Two ticks - different bar" $ do
             value = fromDouble val,
             volume = 1 }
 
-testOneBar :: TestTree
-testOneBar  = testCase "One bar" $ do
-  let series = BarSeries "TEST_TICKER" (Timeframe 3600) []
-  let agg = mkAggregatorFromBars (M.fromList [("TEST_TICKER", series)]) [(0, 86400)]
-  let (mbar, newagg) = handleBar bar agg
-  mbar @?= Nothing
-  (bsBars <$> (M.lookup "TEST_TICKER" $ bars newagg)) @?= Just [Bar "TEST_TICKER" testTimestamp 12.00 18.00 10.00 12.00 68]
-  where
-    testTimestamp = (UTCTime (fromGregorian 1970 1 1) 60)
-    bar = Bar {
-            barSecurity = "TEST_TICKER",
-            barTimestamp = testTimestamp,
-            barOpen = fromDouble 12.00,
-            barHigh = fromDouble 18.00,
-            barLow = fromDouble 10.00,
-            barClose = fromDouble 12.00,
-            barVolume = 68 }
-
-
-testTwoBarsInSameBar :: TestTree
-testTwoBarsInSameBar = testCase "Two bars (smaller timeframe) - same bar" $ do
-  let series = BarSeries "TEST_TICKER" (Timeframe 600) []
-  let agg = mkAggregatorFromBars (M.fromList [("TEST_TICKER", series)]) [(0, 86400)]
-  let (mbar, newagg) = handleBar (bar testTimestamp1 12.00 13.00 10.00 11.00 1) agg
-  mbar @?= Nothing
-  let (mbar', newagg') = handleBar (bar testTimestamp2 12.00 15.00 11.00 12.00 2) newagg
-  mbar' @?= Nothing
-  (bsBars <$> (M.lookup "TEST_TICKER" $ bars newagg')) @?= Just [Bar "TEST_TICKER" testTimestamp2 12.00 15.00 10.00 12.00 3]
-  where
-    testTimestamp1 = (UTCTime (fromGregorian 1970 1 1) 60)
-    testTimestamp2 = (UTCTime (fromGregorian 1970 1 1) 120)
-    bar ts o h l c v = Bar {
-            barSecurity = "TEST_TICKER",
-            barTimestamp = ts,
-            barOpen = fromDouble o,
-            barHigh = fromDouble h,
-            barLow = fromDouble l,
-            barClose = fromDouble c,
-            barVolume = v }
-
-testTwoBarsInSameBarLastBar :: TestTree
-testTwoBarsInSameBarLastBar = testCase "Two bars (smaller timeframe) - same bar: last bar is exactly at the end of the bigger tf bar" $ do
-  let series = BarSeries "TEST_TICKER" (Timeframe 600) []
-  let agg = mkAggregatorFromBars (M.fromList [("TEST_TICKER", series)]) [(0, 86400)]
-  let (mbar, newagg) = handleBar (bar testTimestamp1 12.00 13.00 10.00 11.00 1) agg
-  mbar @?= Nothing
-  let (mbar', newagg') = handleBar (bar testTimestamp2 12.00 15.00 11.00 12.00 2) newagg
-  let expectedBar = Bar "TEST_TICKER" testTimestamp2 12.00 15.00 10.00 12.00 3
-  mbar' @?= Just expectedBar
-  (head . tail <$> bsBars <$> (M.lookup "TEST_TICKER" $ bars newagg')) @?= Just expectedBar
-  where
-    testTimestamp1 = (UTCTime (fromGregorian 1970 1 1) 560)
-    testTimestamp2 = (UTCTime (fromGregorian 1970 1 1) 600)
-    bar ts o h l c v = Bar {
-            barSecurity = "TEST_TICKER",
-            barTimestamp = ts,
-            barOpen = fromDouble o,
-            barHigh = fromDouble h,
-            barLow = fromDouble l,
-            barClose = fromDouble c,
-            barVolume = v }
-
-testNextBarAfterBarClose :: TestTree
-testNextBarAfterBarClose = testCase "Three bars (smaller timeframe) - next bar after bigger tf bar close" $ do
-  let series = BarSeries "TEST_TICKER" (Timeframe 600) []
-  let agg = mkAggregatorFromBars (M.fromList [("TEST_TICKER", series)]) [(0, 86400)]
-  let (_, newagg) = handleBar (bar testTimestamp1 12.00 13.00 10.00 11.00 1) agg
-  let (_, newagg') = handleBar (bar testTimestamp2 12.00 15.00 11.00 12.00 2) newagg
-  let (_, newagg'') = handleBar (bar testTimestamp3 12.00 15.00 11.00 12.00 12) newagg'
-  let expectedBar = Bar "TEST_TICKER" testTimestamp3 12.00 15.00 11.00 12.00 12
-  (head <$> bsBars <$> (M.lookup "TEST_TICKER" $ bars newagg'')) @?= Just expectedBar
-  where
-    testTimestamp1 = (UTCTime (fromGregorian 1970 1 1) 560)
-    testTimestamp2 = (UTCTime (fromGregorian 1970 1 1) 600)
-    testTimestamp3 = (UTCTime (fromGregorian 1970 1 1) 660)
-    bar ts o h l c v = Bar {
-            barSecurity = "TEST_TICKER",
-            barTimestamp = ts,
-            barOpen = fromDouble o,
-            barHigh = fromDouble h,
-            barLow = fromDouble l,
-            barClose = fromDouble c,
-            barVolume = v }
-
-testUpdateTime :: TestTree
-testUpdateTime = testCase "updateTime - next bar - creates new bar with zero volume" $ do
-  let series = BarSeries "TEST_TICKER" (Timeframe 3600) []
-  let agg = mkAggregatorFromBars (M.fromList [("TEST_TICKER", series)]) [(0, 86400)]
-  let (_, newagg) = handleBar (bar testTimestamp1 12.00 13.00 10.00 11.00 1) agg
-  let (_, newagg') = handleBar (bar testTimestamp2 12.00 15.00 11.00 12.00 2) newagg
-  let (newBar, newagg'') = updateTime (tick testTimestamp4 13.00 100) newagg'
-  let expectedNewBar = Bar "TEST_TICKER" testTimestamp2 12.00 15.00 10.00 12.00 3
-  let expectedBar = Bar "TEST_TICKER" testTimestamp4 13.00 13.00 13.00 13.00 0
-  (head <$> bsBars <$> (M.lookup "TEST_TICKER" $ bars newagg'')) @?= Just expectedBar
-  newBar @?= Just expectedNewBar
-  where
-    testTimestamp1 = (UTCTime (fromGregorian 1970 1 1) 560)
-    testTimestamp2 = (UTCTime (fromGregorian 1970 1 1) 600)
-    testTimestamp3 = (UTCTime (fromGregorian 1970 1 1) 3600)
-    testTimestamp4 = (UTCTime (fromGregorian 1970 1 1) 3660)
-    tick ts v vol = Tick {
-              security = "TEST_TICKER"
-            , datatype = LastTradePrice
-            , timestamp = ts
-            , value = v
-            , volume = vol }
-    bar ts o h l c v = Bar {
-            barSecurity = "TEST_TICKER",
-            barTimestamp = ts,
-            barOpen = fromDouble o,
-            barHigh = fromDouble h,
-            barLow = fromDouble l,
-            barClose = fromDouble c,
-            barVolume = v }
 
 prop_allTicksInOneBar :: TestTree
 prop_allTicksInOneBar = QC.testProperty "All ticks in one bar" $ QC.forAll (QC.choose (1, 86400)) $ \timeframe ->
@@ -236,13 +119,13 @@ prop_allTicksInOneBar = QC.testProperty "All ticks in one bar" $ QC.forAll (QC.c
             ((barClose <$> currentBar "TEST_TICKER" agg) == (value <$> lastMay ticks')) &&
             ((barVolume <$> currentBar "TEST_TICKER" agg) == Just (sum $ volume <$> ticks))
   where
-    genTick :: T.Text -> UTCTime -> Integer -> Gen Tick
+    genTick :: T.Text -> UTCTime -> Int -> Gen Tick
     genTick tickerId base tf = do
-      difftime <- fromRational . toRational . picosecondsToDiffTime <$> choose (0, truncate 1e12 * tf)
+      difftime <- fromRational . toRational . picosecondsToDiffTime <$> choose (0, truncate 1e12 * fromIntegral tf)
       val <- arbitrary
       vol <- arbitrary `suchThat` (> 0)
       return $ Tick tickerId LastTradePrice (difftime `addUTCTime` baseTime) val vol
-    mkAggregator tickerId tf = mkAggregatorFromBars (M.singleton tickerId (BarSeries tickerId (Timeframe tf) [])) [(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))
     baseTime = UTCTime (fromGregorian 1970 1 1) 0

test/Test/Driver/Junction/QuoteThread.hs

@@ -0,0 +1,82 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+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.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           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          (mkMockHistoryProvider)
+import           Test.Mock.TickerInfoProvider       (mkMockTickerInfoProvider)
+
+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 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
+          }

test/Test/Mock/HistoryProvider.hs

@@ -0,0 +1,25 @@
+
+module Test.Mock.HistoryProvider
+(
+  mkMockHistoryProvider
+) where
+
+import           ATrade.Quotes.HistoryProvider
+import           ATrade.RoboCom.Types          (BarSeriesId (BarSeriesId), Bars)
+import           ATrade.Types                  (Bar (Bar, barTimestamp),
+                                                BarTimeframe (BarTimeframe),
+                                                TickerId)
+import qualified Data.Map.Strict               as M
+import           Data.Time                     (UTCTime)
+
+mkMockHistoryProvider :: M.Map BarSeriesId [Bar] -> HistoryProvider
+mkMockHistoryProvider bars = HistoryProvider $ mockGetHistory bars
+
+mockGetHistory :: M.Map BarSeriesId [Bar] -> TickerId -> BarTimeframe -> UTCTime -> UTCTime -> IO [Bar]
+mockGetHistory bars tid tf from to =
+  case M.lookup (BarSeriesId tid tf) bars of
+    Just series -> return $ filter (\bar -> (barTimestamp bar >= from) && (barTimestamp bar <= to)) series
+    Nothing     -> return []
+
+
+

test/Test/Mock/TickerInfoProvider.hs

@@ -0,0 +1,17 @@
+
+module Test.Mock.TickerInfoProvider
+(
+  mkMockTickerInfoProvider
+) where
+
+import           ATrade.Quotes.TickerInfoProvider
+import           ATrade.RoboCom.Types             (InstrumentParameters)
+import           ATrade.Types                     (TickerId)
+import qualified Data.Map.Strict                  as M
+import           Data.Maybe                       (catMaybes, mapMaybe)
+
+mkMockTickerInfoProvider :: M.Map TickerId InstrumentParameters -> TickerInfoProvider
+mkMockTickerInfoProvider params = TickerInfoProvider $ mockGetInstrumentParameters params
+
+mockGetInstrumentParameters :: M.Map TickerId InstrumentParameters -> [TickerId] -> IO [InstrumentParameters]
+mockGetInstrumentParameters params = return . mapMaybe (`M.lookup` params)

test/Test/RoboCom/Positions.hs

@@ -1,167 +0,0 @@
-
-{-# LANGUAGE OverloadedStrings #-}
-
-module Test.RoboCom.Positions
-(
-  unitTests
-) where
-
-import           Test.Tasty
-import           Test.Tasty.HUnit
-import           Test.Tasty.QuickCheck as QC
-import           Test.Tasty.SmallCheck as SC
-
-import           ATrade.Types
-import qualified Data.Text             as T
-import qualified Data.Map.Strict     as M
-import           Data.Time.Calendar
-import           Data.Time.Clock
-import qualified Data.List as L
-
-import           ATrade.RoboCom.Monad
-import           ATrade.RoboCom.Positions
-import ATrade.RoboCom.Types
-
-data TestState = TestState
-  {
-    positions :: [Position],
-    testInt :: Int
-  }
-
-defaultState = TestState {
-  positions = [],
-  testInt = 0
-  }
-
-data TestConfig = TestConfig
-
-instance ParamsHasMainTicker TestConfig where
-  mainTicker _ = "TEST_TICKER"
-
-instance StateHasPositions TestState where
-  getPositions = positions
-  setPositions a p = a { positions = p }
-
-defaultStrategyEnvironment = StrategyEnvironment
-  {
-    seInstanceId = "test_instance",
-    seAccount = "test_account",
-    seVolume = 1,
-    seBars = M.empty,
-    seLastTimestamp = (UTCTime (fromGregorian 1970 1 1) 0)
-  }
-
-unitTests = testGroup "RoboCom.Positions" [
-  testEnterAtMarket,
-  testEnterAtMarketSendsAction,
-  testDefaultHandlerSubmissionDeadline,
-  testDefaultHandlerAfterSubmissionPositionIsWaitingOpen,
-  testDefaultHandlerPositionWaitingOpenOrderOpenExecuted1 
-  ]
-
-testEnterAtMarket = testCase "enterAtMarket creates position in PositionWaitingOpenSubmission state" $ do
-  let (newState, actions, _) = runStrategyElement TestConfig defaultState defaultStrategyEnvironment element
-  assertBool "Should be exactly 1 position" ((length . positions) newState == 1)
-  let pos = head . positions $ newState
-  assertBool "Should be in PositionWaitingOpenSubmission" (isPositionWaitingOpenSubmission . posState $ pos)
-  let (PositionWaitingOpenSubmission order) = posState pos
-  assertBool "Account should be 'test_account'" (orderAccountId order == "test_account")
-  assertBool "Security should be 'TEST_TICKER'" (orderSecurity order == "TEST_TICKER")
-  assertBool "Order price should be Market" (orderPrice order == Market)
-  assertBool "Order quantity should be 1" (orderQuantity order == 1)
-  assertBool "Executed order quantity should be 0" (orderExecutedQuantity order == 0)
-  assertBool "Order operation should be Buy" (orderOperation order == Buy)
-  assertBool "Order signal id should be correct" (orderSignalId order == (SignalId "test_instance" "long" ""))
-  where
-    element = enterAtMarket "long" Buy
-
-    isPositionWaitingOpenSubmission (PositionWaitingOpenSubmission _) = True
-    isPositionWaitingOpenSubmission _ = False
-
-testEnterAtMarketSendsAction = testCase "enterAtMarket sends ActionSubmitOrder" $ do
-  let (newState, actions, _) = runStrategyElement TestConfig defaultState defaultStrategyEnvironment element
-  case (L.find isActionOrder actions) of
-    Just (ActionOrder order) -> do
-      assertBool "Account should be 'test_account'" (orderAccountId order == "test_account")
-      assertBool "Security should be 'TEST_TICKER'" (orderSecurity order == "TEST_TICKER")
-      assertBool "Order price should be Market" (orderPrice order == Market)
-      assertBool "Order quantity should be 1" (orderQuantity order == 1)
-      assertBool "Executed order quantity should be 0" (orderExecutedQuantity order == 0)
-      assertBool "Order operation should be Buy" (orderOperation order == Buy)
-      assertBool "Order signal id should be correct" (orderSignalId order == (SignalId "test_instance" "long" ""))
-    Nothing -> assertFailure "Should be exactly 1 ActionOrder"
-  where
-    element = enterAtMarket "long" Buy
-
-    isActionOrder (ActionOrder _) = True
-    isActionOrder _ = False
-    
-testDefaultHandlerSubmissionDeadline = testCase "defaultHandler after submission deadline marks position as cancelled" $ do
-  let (newState, actions, _) = runStrategyElement TestConfig defaultState defaultStrategyEnvironment element
-  let (newState', actions', _) = runStrategyElement TestConfig newState defaultStrategyEnvironment { seLastTimestamp = afterDeadline } $ defaultHandler (NewTick tick)
-  let pos = head . positions $ newState'
-  assertBool "Cancelled position" (posState pos == PositionCancelled)
-  where
-    element = enterAtMarket "long" Buy
-    afterDeadline = (UTCTime (fromGregorian 1970 1 1) 100)
-    tick = Tick {
-            security = "TEST_TICKER",
-            datatype = LastTradePrice,
-            timestamp = afterDeadline,
-            value = fromDouble 12.00,
-            volume = 1 }
-
-testDefaultHandlerAfterSubmissionPositionIsWaitingOpen = testCase "defaultHandler after successful submission sets position state as PositionWaitingOpen" $ do
-  let (newState, actions, _) = runStrategyElement TestConfig defaultState defaultStrategyEnvironment element
-  let pos = head . positions $ newState
-  let (PositionWaitingOpenSubmission order) = posState pos
-  let (newState', actions', _) = runStrategyElement TestConfig newState defaultStrategyEnvironment { seLastTimestamp = beforeDeadline } $ defaultHandler (OrderSubmitted order {orderId = 1 })
-  let pos' = head . positions $ newState'
-  assertEqual "New position state should be PositionWaitingOpen" (posState pos') PositionWaitingOpen
-  where
-    element = enterAtMarket "long" Buy
-    beforeDeadline = (UTCTime (fromGregorian 1970 1 1) 1)
-
-testDefaultHandlerPositionWaitingOpenOrderCancelledExecuted0 = testCase "defaultHandler in PositionWaitingOpen, if order is cancelled and nothing is executed, marks position as cancelled" $ do
-  let (newState, actions, _) = runStrategyElement TestConfig defaultState defaultStrategyEnvironment element
-  let pos = head . positions $ newState
-  let (PositionWaitingOpenSubmission order) = posState pos
-  let (newState', actions', _) = runStrategyElement TestConfig newState defaultStrategyEnvironment { seLastTimestamp = ts1 } $ defaultHandler (OrderSubmitted order {orderId = 1 })
-  let (newState'', actions'', _) = runStrategyElement TestConfig newState defaultStrategyEnvironment { seLastTimestamp = ts2 } $ defaultHandler (OrderUpdate 1 Cancelled)
-  let pos = head . positions $ newState''
-  assertEqual "New position state should be PositionCancelled" (posState pos) PositionCancelled
-  where
-    element = enterAtMarket "long" Buy
-    ts1 = (UTCTime (fromGregorian 1970 1 1) 1)
-    ts2 = (UTCTime (fromGregorian 1970 1 1) 2)
-
-testDefaultHandlerPositionWaitingOpenOrderOpenExecuted1 = testCase "defaultHandler in PositionWaitingOpen, if order is cancelled and something is executed, marks position as open" $ do
-  let (newState, actions, _) = runStrategyElement TestConfig defaultState defaultStrategyEnvironment element
-  let pos = head . positions $ newState
-  let (PositionWaitingOpenSubmission order) = posState pos
-  let (newState', actions', _) = runStrategyElement TestConfig newState defaultStrategyEnvironment { seLastTimestamp = ts1, seVolume = 2 } $ defaultHandler (OrderSubmitted order {orderId = 1 })
-  let (newState'', actions'', _) = runStrategyElement TestConfig newState' defaultStrategyEnvironment { seLastTimestamp = ts2 } $ defaultHandler (NewTrade trade)
-  let (newState''', actions''', _) = runStrategyElement TestConfig newState'' defaultStrategyEnvironment { seLastTimestamp = ts3 } $ defaultHandler (OrderUpdate 1 Cancelled)
-  let pos = head . positions $ newState'''
-  assertEqual "New position state should be PositionOpen" (posState pos) PositionOpen
-  where
-    element = enterAtMarket "long" Buy
-    ts1 = (UTCTime (fromGregorian 1970 1 1) 1)
-    ts2 = (UTCTime (fromGregorian 1970 1 1) 2)
-    ts3 = (UTCTime (fromGregorian 1970 1 1) 3)
-    trade = Trade
-            {
-              tradeOrderId = 1,
-              tradePrice = fromDouble 10,
-              tradeQuantity = 1,
-              tradeVolume = fromDouble 10,
-              tradeVolumeCurrency = "FOO",
-              tradeOperation = Buy,
-              tradeAccount = "test_account",
-              tradeSecurity = "TEST_TICKER",
-              tradeTimestamp = ts3,
-              tradeCommission = fromDouble 0,
-              tradeSignalId = SignalId "test_instance" "long" ""
-            }
-
-