WIP

robocom-zero.cabal

@@ -34,6 +34,7 @@ library
                      , ATrade.Driver.Junction.QuoteThread
                      , ATrade.Driver.Junction.QuoteStream
                      , ATrade.Driver.Junction.RobotDriverThread
+                     , ATrade.Driver.Junction.ProgramConfiguration
                      , ATrade.BarAggregator
                      , ATrade.RoboCom
                      , ATrade.Quotes.HistoryProvider

src/ATrade/Driver/Junction.hs

@@ -1,5 +1,8 @@
 {-# LANGUAGE DeriveGeneric              #-}
 {-# LANGUAGE DuplicateRecordFields      #-}
+{-# LANGUAGE FlexibleInstances          #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
 {-# LANGUAGE OverloadedStrings          #-}
 
 module ATrade.Driver.Junction
@@ -7,119 +10,173 @@ module ATrade.Driver.Junction
     junctionMain
   ) where
 
-import           ATrade.Driver.Junction.Types  (StrategyDescriptor (..),
+import           ATrade.Broker.Client                        (startBrokerClient,
-                                                StrategyInstance (..),
+                                                              stopBrokerClient)
-                                                StrategyInstanceDescriptor (..))
+import           ATrade.Driver.Junction.ProgramConfiguration (ProgramConfiguration (brokerEndpoint, brokerNotificationEndpoint, instances, qhpEndpoint, qtisEndpoint, redisSocket, robotsConfigsPath),
-import           ATrade.RoboCom.Types          (Ticker (..))
+                                                              ProgramOptions (ProgramOptions, configPath))
-import           Control.Concurrent            (forkIO)
+import           ATrade.Driver.Junction.QuoteStream          (QuoteStream (addSubscription, removeSubscription))
-import           Control.Concurrent.Async      (forConcurrently_)
+import           ATrade.Driver.Junction.QuoteThread          (DownloaderEnv (DownloaderEnv),
-import           Control.Concurrent.STM        (atomically)
+                                                              withQThread)
-import           Control.Concurrent.STM.TQueue (newTQueueIO)
+import           ATrade.Driver.Junction.RobotDriverThread    (createRobotDriverThread)
-import           Control.Concurrent.STM.TVar   (newTVarIO)
+import           ATrade.Driver.Junction.Types                (StrategyDescriptorE (StrategyDescriptorE),
-import           Data.Aeson                    (FromJSON (..), ToJSON (..),
+                                                              StrategyInstanceDescriptor (..),
-                                                decode, object, withObject,
+                                                              confStrategy)
-                                                (.:), (.=))
+import           ATrade.Quotes.QHP                           (mkQHPHandle)
-import qualified Data.ByteString               as B
+import           ATrade.RoboCom.ConfigStorage                (ConfigStorage (loadConfig))
+import           ATrade.RoboCom.Monad                        (MonadRobot (..))
+import           ATrade.RoboCom.Persistence                  (MonadPersistence (loadState, saveState))
+import           ATrade.Types                                (ClientSecurityParams (ClientSecurityParams))
+import           Control.Exception.Safe                      (MonadThrow,
+                                                              bracket)
+import           Control.Monad                               (forM_)
+import           Control.Monad.IO.Class                      (MonadIO (liftIO))
+import           Control.Monad.Reader                        (MonadReader, ReaderT (runReaderT),
+                                                              asks)
+import           Data.Aeson                                  (eitherDecode,
+                                                              encode)
 import qualified Data.ByteString.Lazy                        as BL
-import           Data.IORef
+import           Data.Default                                (Default (def))
+import           Data.IORef                                  (IORef, newIORef)
 import qualified Data.Map.Strict                             as M
-import           Data.Maybe                    (fromMaybe)
-import           Data.Semigroup                ((<>))
 import qualified Data.Text                                   as T
+import           Data.Text.Encoding                          (encodeUtf8)
 import           Data.Text.IO                                (readFile)
-import           Dhall                         (FromDhall, auto, input)
+import           Data.Time.Clock.POSIX                       (getPOSIXTime)
-import           GHC.Generics                  (Generic)
+import           Database.Redis                              (ConnectInfo (..),
-import           Options.Applicative           (Parser, execParser, fullDesc,
+                                                              Connection,
-                                                header, help, helper, info,
+                                                              PortID (UnixSocket),
-                                                long, metavar, progDesc, short,
+                                                              checkedConnect,
-                                                strOption, (<**>))
+                                                              defaultConnectInfo,
+                                                              get, mset,
+                                                              runRedis)
+import           Dhall                                       (auto, input)
+import           Options.Applicative                         (Parser,
+                                                              execParser,
+                                                              fullDesc, header,
+                                                              help, helper,
+                                                              info, long,
+                                                              metavar, progDesc,
+                                                              short, strOption,
+                                                              (<**>))
 import           Prelude                                     hiding (readFile)
+import           System.Log.Logger                           (warningM)
+import           System.ZMQ4                                 (withContext)
 
-data BigConfig c = BigConfig {
+data PersistenceEnv =
-  confTickers  :: [Ticker],
+  PersistenceEnv
-  confStrategy :: c
-}
-
-instance (FromJSON c) => FromJSON (BigConfig c) where
-  parseJSON = withObject "object" (\obj -> BigConfig <$>
-    obj .: "tickers" <*>
-    obj .: "params")
-
-instance (ToJSON c) => ToJSON (BigConfig c) where
-  toJSON conf = object ["tickers" .= confTickers conf,
-    "params" .= confStrategy conf ]
-
-data ProgramOptions =
-  ProgramOptions
   {
-    configPath :: FilePath
+    peRedisSocket :: Connection,
+    peConfigPath  :: FilePath
   }
 
-data ProgramConfiguration =
+newtype PersistenceT a = PersistenceT { unPersistenceT :: ReaderT PersistenceEnv IO a }
-  ProgramConfiguration
+  deriving (Functor, Applicative, Monad, MonadReader PersistenceEnv, MonadIO, MonadThrow)
+
+instance ConfigStorage PersistenceT where
+  loadConfig key = do
+    basePath <- asks peConfigPath
+    let path = basePath <> "/" <> T.unpack key -- TODO fix path construction
+    liftIO $ readFile path >>= input auto
+
+instance MonadPersistence PersistenceT where
+  saveState newState key = do
+    conn <- asks peRedisSocket
+    now <- liftIO getPOSIXTime
+    res <- liftIO $ runRedis conn $ mset [(encodeUtf8 key, BL.toStrict $ encode newState),
+                                 (encodeUtf8 (key <> ":last_store") , encodeUtf8 . T.pack . show $ now)]
+    case res of
+      Left _  -> liftIO $ warningM "main" "Unable to save state"
+      Right _ -> return ()
+
+  loadState key = do
+    conn <- asks peRedisSocket
+    res <- liftIO $ runRedis conn $ get (encodeUtf8 key)
+    -- TODO: just chain eithers
+    case res of
+      Left _ -> do
+        liftIO $ warningM "main" "Unable to load state"
+        return def
+      Right maybeRawState ->
+        case maybeRawState of
+          Just rawState -> case eitherDecode $ BL.fromStrict rawState of
+            Left _ -> do
+              liftIO $ warningM "main" "Unable to decode state"
+              return def
+            Right decodedState -> return decodedState
+          Nothing -> do
+            liftIO $ warningM "main" "Unable to decode state"
+            return def
+
+instance QuoteStream PersistenceT where
+  addSubscription sub chan = undefined
+  removeSubscription sub = undefined
+
+data RobotEnv c s =
+  RobotEnv
   {
-    brokerEndpoint        :: T.Text,
+    stateRef  :: IORef s,
-    brokerServerCert      :: Maybe FilePath,
+    configRef :: IORef c
-    brokerClientCert      :: Maybe FilePath,
+  }
-    quotesourceEndpoint   :: T.Text,
+
-    quotesourceServerCert :: Maybe FilePath,
+newtype RobotM c s a = RobotM { unRobotM :: ReaderT (RobotEnv c s) IO a }
-    quotesourceClientCert :: Maybe FilePath,
+  deriving (Functor, Applicative, Monad, MonadReader (RobotEnv c s), MonadIO, MonadThrow)
-    qhpEndpoint           :: T.Text,
+
-    qtisEndpoint          :: T.Text,
+instance MonadRobot (RobotM c s) c s where
-    redisSocket           :: T.Text,
+  submitOrder = undefined
-    globalLog             :: FilePath,
+  cancelOrder = undefined
-    instances             :: [StrategyInstanceDescriptor]
+  appendToLog = undefined
-  } deriving (Generic, Show)
+  setupTimer = undefined
-
+  enqueueIOAction = undefined
-instance FromDhall ProgramConfiguration
+  getConfig = undefined
-
+  getState = undefined
-load :: T.Text -> IO (Maybe B.ByteString)
+  setState = undefined
-load = undefined
+  getEnvironment = undefined
-
+  getTicker  = undefined
-junctionMain :: M.Map T.Text StrategyDescriptor -> IO ()
+
+junctionMain :: M.Map T.Text StrategyDescriptorE -> IO ()
 junctionMain descriptors = do
   opts <- parseOptions
 
   cfg <- readFile (configPath opts) >>= input auto
 
-  bars <- newTVarIO M.empty
+  barsMap <- newIORef M.empty
-
+
-  strategies <- mkStrategies (instances cfg)
+  redis <- checkedConnect (defaultConnectInfo { connectPort = UnixSocket (T.unpack $ redisSocket cfg) })
-
+  withContext $ \ctx -> do
-  start strategies bars
+    let env = DownloaderEnv (mkQHPHandle ctx (qhpEndpoint cfg)) ctx (qtisEndpoint cfg)
-
+    withBroker cfg ctx $ \bro ->
+      withQThread env barsMap cfg ctx $ \qt ->
+        withPersistence (PersistenceEnv redis $ robotsConfigsPath cfg) $
+          forM_ (instances cfg) $ \inst ->
+            case M.lookup (strategyBaseName inst) descriptors of
+              Just (StrategyDescriptorE desc) -> do
+                bigConf <- loadConfig (configKey inst)
+                rConf <- liftIO $ newIORef (confStrategy bigConf)
+                rState <- loadState (stateKey inst) >>= liftIO . newIORef
+                let robotEnv = RobotEnv rState rConf
+                createRobotDriverThread inst desc (flip runReaderT robotEnv . unRobotM) bigConf rConf rState
+              Nothing   -> error "Unknown strategy"
   where
+    withPersistence :: PersistenceEnv -> PersistenceT () -> IO ()
+    withPersistence env = (`runReaderT` env) . unPersistenceT
+
+    withBroker cfg ctx f = bracket
+      (startBrokerClient
+        "broker"
+        ctx
+        (brokerEndpoint cfg)
+        (brokerNotificationEndpoint cfg)
+        []
+        (ClientSecurityParams -- TODO load certificates from file
+         Nothing
+         Nothing))
+      stopBrokerClient f
     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
-
-    mkStrategy :: StrategyInstanceDescriptor -> IO StrategyInstance
-    mkStrategy desc = do
-      sState <- load (stateKey desc)
-      sCfg <- load (configKey desc)
-      case M.lookup (strategyId desc) descriptors of
-        Just (StrategyDescriptor _sName sCallback sDefState) ->
-          case (sCfg >>= decode . BL.fromStrict, fromMaybe sDefState (sState >>= decode . BL.fromStrict)) of
-            (Just bigConfig, pState) -> do
-              cfgRef <- newIORef (confStrategy bigConfig)
-              stateRef <- newIORef pState
-              return $ StrategyInstance
-                {
-                  strategyInstanceId = strategyName desc,
-                  strategyEventCallback  = sCallback,
-                  strategyState = stateRef,
-                  strategyConfig = cfgRef
-                }
-            _ -> error "Can't read state and config"
-        _ -> error $ "Can't find strategy: " ++ T.unpack (strategyId desc)
-
-    start strategies bars = undefined
-
     optionsParser :: Parser ProgramOptions
     optionsParser = ProgramOptions
       <$> strOption

src/ATrade/Driver/Junction/ProgramConfiguration.hs

@@ -0,0 +1,37 @@
+{-# LANGUAGE DeriveGeneric #-}
+
+module ATrade.Driver.Junction.ProgramConfiguration
+  (
+    ProgramOptions(..),
+    ProgramConfiguration(..)
+  ) where
+import           ATrade.Driver.Junction.Types (StrategyInstanceDescriptor)
+import qualified Data.Text                    as T
+import           Dhall                        (FromDhall)
+import           GHC.Generics                 (Generic)
+
+newtype ProgramOptions =
+  ProgramOptions
+  {
+    configPath :: FilePath
+  }
+
+data ProgramConfiguration =
+  ProgramConfiguration
+  {
+    brokerEndpoint             :: T.Text,
+    brokerNotificationEndpoint :: 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,
+    robotsConfigsPath          :: FilePath,
+    globalLog                  :: FilePath,
+    instances                  :: [StrategyInstanceDescriptor]
+  } deriving (Generic, Show)
+
+instance FromDhall ProgramConfiguration

src/ATrade/Driver/Junction/QuoteStream.hs

@@ -0,0 +1,27 @@
+{-# LANGUAGE DeriveGeneric #-}
+
+module ATrade.Driver.Junction.QuoteStream
+  (
+    QuoteSubscription(..),
+    QuoteStream(..),
+    SubscriptionId(..)
+  ) where
+
+import           ATrade.QuoteSource.Client      (QuoteData)
+import           ATrade.Types                   (BarTimeframe, TickerId)
+import           Control.Concurrent.BoundedChan (BoundedChan)
+import           Data.Hashable                  (Hashable)
+import           GHC.Generics                   (Generic)
+
+data QuoteSubscription =
+  QuoteSubscription TickerId BarTimeframe
+  deriving (Generic, Eq)
+
+instance Hashable BarTimeframe
+instance Hashable QuoteSubscription
+
+newtype SubscriptionId = SubscriptionId { unSubscriptionId :: Int }
+
+class (Monad m) => QuoteStream m where
+  addSubscription :: QuoteSubscription -> BoundedChan QuoteData -> m SubscriptionId
+  removeSubscription :: SubscriptionId -> m ()

src/ATrade/Driver/Junction/QuoteThread.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveGeneric              #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE LambdaCase                 #-}
 {-# LANGUAGE ScopedTypeVariables        #-}
 
@@ -7,11 +8,19 @@ module ATrade.Driver.Junction.QuoteThread
    QuoteThreadHandle,
    startQuoteThread,
    stopQuoteThread,
-   addSubscription
+   addSubscription,
+   DownloaderM,
+   DownloaderEnv(..),
+   runDownloaderM,
+   withQThread
  ) where
 
+import           ATrade.Driver.Junction.ProgramConfiguration (ProgramConfiguration (..))
 import           ATrade.Driver.Junction.QuoteStream          (QuoteSubscription (..))
 import           ATrade.Quotes.HistoryProvider               (HistoryProvider (..))
+import           ATrade.Quotes.QHP                           (QHPHandle, requestHistoryFromQHP)
+import           ATrade.Quotes.QTIS                          (TickerInfo (tiLotSize, tiTickSize, tiTicker),
+                                                              qtisGetTickersInfo)
 import           ATrade.Quotes.TickerInfoProvider            (TickerInfoProvider (..))
 import           ATrade.QuoteSource.Client                   (QuoteData (QDBar, QDTick),
                                                               QuoteSourceClientHandle,
@@ -21,25 +30,33 @@ import           ATrade.QuoteSource.Client          (QuoteData (QDBar, QDTick),
 import           ATrade.RoboCom.Types                        (Bar (barSecurity),
                                                               BarSeries (..),
                                                               BarSeriesId (BarSeriesId),
-                                                     Bars, InstrumentParameters)
+                                                              Bars,
+                                                              InstrumentParameters (InstrumentParameters))
 import           ATrade.Types                                (BarTimeframe (BarTimeframe),
                                                               ClientSecurityParams (ClientSecurityParams),
-                                                     Tick (security), TickerId)
+                                                              Tick (security),
+                                                              TickerId)
 import           Control.Concurrent                          (ThreadId, forkIO,
                                                               killThread)
 import           Control.Concurrent.BoundedChan              (BoundedChan,
-                                                     newBoundedChan, readChan,
+                                                              newBoundedChan,
+                                                              readChan,
                                                               writeChan)
-import           Control.Monad                      (forever)
+import           Control.Exception.Safe                      (MonadThrow,
-import           Control.Monad.Reader               (MonadIO (liftIO),
+                                                              bracket)
-                                                     ReaderT (runReaderT), lift)
+import           Control.Monad                               (forM, forever)
-import           Control.Monad.Reader.Class         (asks)
+import           Control.Monad.Reader                        (MonadIO (liftIO), ReaderT (runReaderT),
+                                                              lift)
+import           Control.Monad.Reader.Class                  (MonadReader, asks)
 import qualified Data.HashMap.Strict                         as HM
-import           Data.IORef                         (IORef, atomicModifyIORef',
+import           Data.IORef                                  (IORef,
-                                                     newIORef, readIORef)
+                                                              atomicModifyIORef',
+                                                              newIORef,
+                                                              readIORef)
 import qualified Data.Map.Strict                             as M
 import qualified Data.Text                                   as T
-import           Data.Time                          (addUTCTime, getCurrentTime)
+import           Data.Time                                   (addUTCTime,
+                                                              getCurrentTime)
 import           System.ZMQ4                                 (Context)
 import           System.ZMQ4.ZAP                             (CurveCertificate)
 
@@ -140,5 +157,45 @@ updateBarsMap barsMap bar tf = M.adjust (addToSeries bar) (BarSeriesId (barSecur
 addToSeries :: Bar -> BarSeries -> BarSeries
 addToSeries bar series = series { bsBars = bar : bsBars series }
 
+data DownloaderEnv =
+  DownloaderEnv
+  {
+    qhp                    :: QHPHandle,
+    downloaderContext      :: Context,
+    downloaderQtisEndpoint :: T.Text
+  }
+
+newtype DownloaderM a = DownloaderM { unDownloaderM :: ReaderT DownloaderEnv IO a }
+  deriving (Functor, Applicative, Monad, MonadReader DownloaderEnv, MonadIO, MonadThrow)
+
+instance HistoryProvider DownloaderM where
+  getHistory tid tf from to = do
+    q <- asks qhp
+    requestHistoryFromQHP q tid tf from to
+
+instance TickerInfoProvider DownloaderM where
+  getInstrumentParameters tickers = do
+    ctx <- asks downloaderContext
+    ep <- asks downloaderQtisEndpoint
+    tis <- liftIO $ forM tickers (qtisGetTickersInfo ctx ep)
+    pure $ convert `fmap` tis
+    where
+      convert ti = InstrumentParameters
+                     (tiTicker ti)
+                     (fromInteger $ tiLotSize ti)
+                     (tiTickSize ti)
 
+withQThread :: DownloaderEnv -> IORef Bars -> ProgramConfiguration -> Context -> (QuoteThreadHandle -> IO ()) -> IO ()
+withQThread env barsMap cfg ctx =
+    bracket
+    (startQuoteThread
+        barsMap
+        ctx
+        (quotesourceEndpoint cfg)
+        Nothing
+        Nothing
+        (runDownloaderM env))
+    stopQuoteThread
 
+runDownloaderM :: DownloaderEnv -> DownloaderM () -> IO ()
+runDownloaderM env = (`runReaderT` env) . unDownloaderM

src/ATrade/Driver/Junction/RobotDriverThread.hs

@@ -0,0 +1,95 @@
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE RankNTypes                #-}
+
+module ATrade.Driver.Junction.RobotDriverThread
+  (
+  createRobotDriverThread
+  ) where
+
+import           ATrade.Driver.Junction.QuoteStream (QuoteStream (addSubscription),
+                                                     QuoteSubscription (QuoteSubscription))
+import           ATrade.Driver.Junction.Types       (BigConfig,
+                                                     StrategyDescriptor,
+                                                     StrategyInstance (StrategyInstance, strategyEventCallback),
+                                                     StrategyInstanceDescriptor (configKey),
+                                                     confStrategy, confTickers,
+                                                     eventCallback, stateKey,
+                                                     strategyId, tickerId,
+                                                     timeframe)
+import           ATrade.QuoteSource.Client          (QuoteData (..))
+import           ATrade.RoboCom.ConfigStorage       (ConfigStorage (loadConfig))
+import           ATrade.RoboCom.Monad               (Event (NewBar, NewTick, NewTrade, OrderUpdate),
+                                                     EventCallback, MonadRobot)
+import           ATrade.RoboCom.Persistence         (MonadPersistence (loadState))
+import           ATrade.Types                       (OrderId, OrderState, Trade)
+import           Control.Concurrent                 (ThreadId, forkIO)
+import           Control.Concurrent.BoundedChan     (BoundedChan,
+                                                     newBoundedChan, readChan,
+                                                     writeChan)
+import           Control.Monad                      (forM_, forever)
+import           Control.Monad.IO.Class             (MonadIO, liftIO)
+import           Data.Aeson                         (FromJSON, ToJSON)
+import           Data.IORef                         (IORef, newIORef)
+import           Dhall                              (FromDhall)
+
+data RobotDriverHandle = forall c s. RobotDriverHandle (StrategyInstance c s) ThreadId ThreadId (BoundedChan RobotDriverEvent)
+
+data RobotDriverRequest
+
+data RobotDriverEvent =
+    EventRequest RobotDriverRequest
+  | QuoteEvent QuoteData
+  | NewTradeEvent Trade
+  | OrderEvent OrderId OrderState
+
+
+robotDriverThread :: (MonadIO m,
+                      MonadRobot m c s) =>
+  StrategyInstance c s ->
+  BoundedChan RobotDriverEvent ->
+  m ()
+
+robotDriverThread inst eventQueue =
+  forever $ liftIO (readChan eventQueue) >>= handleEvent
+  where
+    handleEvent (EventRequest _)           = return ()
+    handleEvent (QuoteEvent d) =
+      case d of
+        QDTick tick     -> strategyEventCallback inst (NewTick tick)
+        QDBar (tf, bar) -> strategyEventCallback inst (NewBar (tf, bar))
+    handleEvent (NewTradeEvent trade)      = strategyEventCallback inst (NewTrade trade)
+    handleEvent (OrderEvent oid newState)  = strategyEventCallback inst (OrderUpdate oid newState)
+
+createRobotDriverThread :: (MonadIO m1,
+                            ConfigStorage m1,
+                            MonadPersistence m1,
+                            QuoteStream m1,
+                            FromJSON s,
+                            ToJSON s,
+                            FromDhall c,
+                            MonadIO m,
+                            MonadRobot m c s) =>
+     StrategyInstanceDescriptor
+  -> StrategyDescriptor c s
+  -> (m () -> IO ())
+  -> BigConfig c
+  -> IORef c
+  -> IORef s
+  -> m1 RobotDriverHandle
+
+createRobotDriverThread instDesc strDesc runner bigConf rConf rState = do
+  eventQueue <- liftIO $ newBoundedChan 2000
+
+  let inst = StrategyInstance (strategyId instDesc) (eventCallback strDesc) rState rConf
+
+  quoteQueue <- liftIO $ newBoundedChan 2000
+  forM_ (confTickers bigConf) (\x -> addSubscription (QuoteSubscription (tickerId x) (timeframe x)) quoteQueue)
+  qthread <- liftIO . forkIO $ forever $ passQuoteEvents eventQueue quoteQueue
+
+  driver <- liftIO . forkIO $ runner $ robotDriverThread inst eventQueue
+  return $ RobotDriverHandle inst driver qthread eventQueue
+
+  where
+    passQuoteEvents eventQueue quoteQueue = do
+      v <- readChan quoteQueue
+      writeChan eventQueue (QuoteEvent v)

src/ATrade/Driver/Junction/Types.hs

@@ -8,19 +8,20 @@ module ATrade.Driver.Junction.Types
     StrategyDescriptor(..),
     TickerConfig(..),
     StrategyInstanceDescriptor(..),
-    StrategyInstance(..)
+    StrategyInstance(..),
-  ) where
+    BigConfig(..)
+  ,StrategyDescriptorE(..)) where
 
 import           ATrade.RoboCom.Monad (EventCallback)
-import           ATrade.Types         (BarTimeframe, TickerId)
+import           ATrade.Types         (BarTimeframe (..), TickerId)
 import           Data.Aeson           (FromJSON (..), ToJSON (..))
-import           Data.IORef
+import           Data.Default         (Default)
+import           Data.IORef           (IORef)
 import qualified Data.Text            as T
 import           Dhall                (FromDhall)
 import           GHC.Generics         (Generic)
 
-data StrategyDescriptor =
+data StrategyDescriptor c s =
-  forall c s. (FromJSON s, ToJSON s, FromJSON c) =>
     StrategyDescriptor
     {
       baseStrategyName :: T.Text,
@@ -28,18 +29,31 @@ data StrategyDescriptor =
       defaultState     :: s
     }
 
+data StrategyDescriptorE = forall c s. (FromDhall c, Default s, FromJSON s, ToJSON s) => StrategyDescriptorE (StrategyDescriptor c s)
+
 data TickerConfig =
   TickerConfig
   {
     tickerId  :: TickerId,
     timeframe :: BarTimeframe
   }
+  deriving (Generic)
+
+instance FromDhall BarTimeframe
+instance FromDhall TickerConfig
+
+data BigConfig c = BigConfig {
+  confTickers  :: [TickerConfig],
+  confStrategy :: c
+} deriving (Generic)
+
+instance (FromDhall c) => FromDhall (BigConfig c)
 
 data StrategyInstanceDescriptor =
   StrategyInstanceDescriptor
   {
     strategyId       :: T.Text,
-    strategyName :: T.Text,
+    strategyBaseName :: T.Text,
     configKey        :: T.Text,
     stateKey         :: T.Text,
     logPath          :: T.Text
@@ -47,8 +61,7 @@ data StrategyInstanceDescriptor =
 
 instance FromDhall StrategyInstanceDescriptor
 
-data StrategyInstance =
+data StrategyInstance c s =
-  forall c s. (FromJSON s, ToJSON s, FromJSON c) =>
     StrategyInstance
     {
       strategyInstanceId    :: T.Text,

src/ATrade/RoboCom/ConfigStorage.hs

@@ -0,0 +1,14 @@
+{-# LANGUAGE RankNTypes #-}
+
+module ATrade.RoboCom.ConfigStorage
+(
+  ConfigStorage(..)
+) where
+
+import qualified Data.Text as T
+import           Dhall     (FromDhall)
+
+class (Monad m) => ConfigStorage m where
+  loadConfig :: forall c. (FromDhall c) => T.Text -> m c
+
+

src/ATrade/RoboCom/Monad.hs

@@ -13,7 +13,6 @@ module ATrade.RoboCom.Monad (
   seInstanceId,
   seAccount,
   seVolume,
-  seBars,
   seLastTimestamp,
   EventCallback,
   Event(..),
@@ -48,13 +47,14 @@ class (Monad m) => MonadRobot m c s | m -> c, m -> s where
     oldState <- getState
     setState (f oldState)
   getEnvironment :: m StrategyEnvironment
+  getTicker :: TickerId -> BarTimeframe -> m (Maybe BarSeries)
 
 st :: QuasiQuoter
 st = t
 
 type EventCallback c s = forall m . MonadRobot m c s => Event -> m ()
 
-data Event = NewBar Bar
+data Event = NewBar (BarTimeframe, Bar)
   | NewTick Tick
   | OrderSubmitted Order
   | OrderUpdate OrderId OrderState
@@ -68,7 +68,6 @@ data StrategyEnvironment = StrategyEnvironment {
   _seInstanceId    :: !T.Text, -- ^ Strategy instance identifier. Should be unique among all strategies (very desirable)
   _seAccount       :: !T.Text, -- ^ Account string to use for this strategy instance. Broker-dependent
   _seVolume        :: !Int, -- ^ Volume to use for this instance (in lots/contracts)
-  _seBars          :: !Bars, -- ^ List of tickers which is used by this strategy
   _seLastTimestamp :: !UTCTime
 } deriving (Eq)
 makeLenses ''StrategyEnvironment

src/ATrade/RoboCom/Persistence.hs

@@ -0,0 +1,16 @@
+{-# LANGUAGE RankNTypes #-}
+
+module ATrade.RoboCom.Persistence
+(
+  MonadPersistence(..)
+) where
+
+import           Data.Aeson
+import           Data.Default (Default)
+import qualified Data.Text    as T
+
+class (Monad m) => MonadPersistence m where
+  saveState :: forall s. (ToJSON s) => s -> T.Text -> m ()
+  loadState :: forall s. (Default s, FromJSON s) => T.Text -> m s
+
+

src/ATrade/RoboCom/Positions.hs

@@ -79,7 +79,6 @@ import           Control.Monad
 
 import           Data.Aeson
 import qualified Data.List            as L
-import qualified Data.Map             as M
 import qualified Data.Text            as T
 import qualified Data.Text.Lazy       as TL
 import           Data.Time.Clock
@@ -145,7 +144,7 @@ modifyPositions f = do
   modifyState (\s -> setPositions s (f pos))
 
 class ParamsHasMainTicker a where
-  mainTicker :: a -> BarSeriesId
+  mainTicker :: a -> (BarTimeframe, TickerId)
 
 -- | 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]
@@ -388,16 +387,16 @@ modifyPosition f oldpos = do
 
 getCurrentTicker :: (ParamsHasMainTicker c, MonadRobot m c s) => m [Bar]
 getCurrentTicker = do
-  mainTicker' <- mainTicker <$> getConfig
+  (tf, mainTicker') <- mainTicker <$> getConfig
-  maybeBars <- view (seBars . at mainTicker') <$> getEnvironment
+  maybeBars <- getTicker mainTicker' tf
   case maybeBars of
     Just b -> return $ bsBars b
     _      -> return []
 
 getCurrentTickerSeries :: (ParamsHasMainTicker c, MonadRobot m c s) => m (Maybe BarSeries)
 getCurrentTickerSeries = do
-  bars <- view seBars <$> getEnvironment
+  (tf, mainTicker') <- mainTicker <$> getConfig
-  flip M.lookup bars . mainTicker <$> getConfig
+  getTicker mainTicker' tf
 
 getLastActivePosition :: (StateHasPositions s, MonadRobot m c s) => m (Maybe Position)
 getLastActivePosition = L.find (\pos -> posState pos == PositionOpen) . getPositions <$> getState
@@ -418,7 +417,7 @@ getAllActiveAndPendingPositions = L.filter
 
 onNewBarEvent :: (MonadRobot m c s) => Event -> (Bar -> m ()) -> m ()
 onNewBarEvent event f = case event of
-  NewBar bar -> f bar
+  NewBar (_, bar) -> f bar
   _               -> doNothing
 
 onNewTickEvent :: (MonadRobot m c s) => Event -> (Tick -> m ()) -> m ()
@@ -464,7 +463,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 <- bsidTickerId . mainTicker <$> getConfig
+  tickerId <- snd . mainTicker <$> getConfig
   submitOrder $ order tickerId
   newPosition (order tickerId) account tickerId operation quantity 20
   where
@@ -490,7 +489,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 <- bsidTickerId . mainTicker <$> getConfig
+  tickerId <- snd . 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

@@ -26,6 +26,7 @@ import           GHC.Generics        (Generic)
 
 data InstrumentParameters =
   InstrumentParameters {
+    ipTickerId :: TickerId,
     ipLotSize  :: Int,
     ipTickSize :: Price
   } deriving (Show, Eq)

stack.yaml

@@ -18,7 +18,7 @@
 #
 # resolver: ./custom-snapshot.yaml
 # resolver: https://example.com/snapshots/2018-01-01.yaml
-resolver: lts-17.14
+resolver: lts-18.18
 
 # User packages to be built.
 # Various formats can be used as shown in the example below.