diff --git a/robocom-zero.cabal b/robocom-zero.cabal index ce6842f..5ca2859 100644 --- a/robocom-zero.cabal +++ b/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 diff --git a/src/ATrade/Driver/Junction.hs b/src/ATrade/Driver/Junction.hs index d9758da..85f5570 100644 --- a/src/ATrade/Driver/Junction.hs +++ b/src/ATrade/Driver/Junction.hs @@ -1,125 +1,182 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} module ATrade.Driver.Junction ( junctionMain ) where -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, - (.:), (.=)) -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], - 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 +import ATrade.Broker.Client (startBrokerClient, + stopBrokerClient) +import ATrade.Driver.Junction.ProgramConfiguration (ProgramConfiguration (brokerEndpoint, brokerNotificationEndpoint, instances, qhpEndpoint, qtisEndpoint, redisSocket, robotsConfigsPath), + ProgramOptions (ProgramOptions, configPath)) +import ATrade.Driver.Junction.QuoteStream (QuoteStream (addSubscription, removeSubscription)) +import ATrade.Driver.Junction.QuoteThread (DownloaderEnv (DownloaderEnv), + withQThread) +import ATrade.Driver.Junction.RobotDriverThread (createRobotDriverThread) +import ATrade.Driver.Junction.Types (StrategyDescriptorE (StrategyDescriptorE), + StrategyInstanceDescriptor (..), + confStrategy) +import ATrade.Quotes.QHP (mkQHPHandle) +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.Default (Default (def)) +import Data.IORef (IORef, newIORef) +import qualified Data.Map.Strict as M +import qualified Data.Text as T +import Data.Text.Encoding (encodeUtf8) +import Data.Text.IO (readFile) +import Data.Time.Clock.POSIX (getPOSIXTime) +import Database.Redis (ConnectInfo (..), + Connection, + PortID (UnixSocket), + checkedConnect, + 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 PersistenceEnv = + PersistenceEnv { - configPath :: FilePath + peRedisSocket :: Connection, + peConfigPath :: FilePath } -data ProgramConfiguration = - ProgramConfiguration +newtype PersistenceT a = PersistenceT { unPersistenceT :: ReaderT PersistenceEnv IO a } + 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, - 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 () + stateRef :: IORef s, + configRef :: IORef c + } + +newtype RobotM c s a = RobotM { unRobotM :: ReaderT (RobotEnv c s) IO a } + deriving (Functor, Applicative, Monad, MonadReader (RobotEnv c s), MonadIO, MonadThrow) + +instance MonadRobot (RobotM c s) c s where + submitOrder = undefined + cancelOrder = undefined + appendToLog = undefined + setupTimer = undefined + enqueueIOAction = undefined + getConfig = undefined + getState = undefined + setState = undefined + getEnvironment = undefined + getTicker = undefined + +junctionMain :: M.Map T.Text StrategyDescriptorE -> IO () junctionMain descriptors = do opts <- parseOptions cfg <- readFile (configPath opts) >>= input auto - bars <- newTVarIO M.empty - - strategies <- mkStrategies (instances cfg) - - start strategies bars - + barsMap <- newIORef M.empty + + redis <- checkedConnect (defaultConnectInfo { connectPort = UnixSocket (T.unpack $ redisSocket cfg) }) + withContext $ \ctx -> do + 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 diff --git a/src/ATrade/Driver/Junction/ProgramConfiguration.hs b/src/ATrade/Driver/Junction/ProgramConfiguration.hs new file mode 100644 index 0000000..ec36c1b --- /dev/null +++ b/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 diff --git a/src/ATrade/Driver/Junction/QuoteStream.hs b/src/ATrade/Driver/Junction/QuoteStream.hs new file mode 100644 index 0000000..d391147 --- /dev/null +++ b/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 () diff --git a/src/ATrade/Driver/Junction/QuoteThread.hs b/src/ATrade/Driver/Junction/QuoteThread.hs index 9c8bac4..d9261df 100644 --- a/src/ATrade/Driver/Junction/QuoteThread.hs +++ b/src/ATrade/Driver/Junction/QuoteThread.hs @@ -1,47 +1,64 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE ScopedTypeVariables #-} module ATrade.Driver.Junction.QuoteThread ( QuoteThreadHandle, startQuoteThread, stopQuoteThread, - addSubscription + addSubscription, + DownloaderM, + DownloaderEnv(..), + runDownloaderM, + withQThread ) where -import ATrade.Driver.Junction.QuoteStream (QuoteSubscription (..)) -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 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 System.ZMQ4 (Context) -import System.ZMQ4.ZAP (CurveCertificate) +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, + quoteSourceClientSubscribe, + startQuoteSourceClient, + stopQuoteSourceClient) +import ATrade.RoboCom.Types (Bar (barSecurity), + BarSeries (..), + BarSeriesId (BarSeriesId), + Bars, + InstrumentParameters (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.Exception.Safe (MonadThrow, + bracket) +import Control.Monad (forM, forever) +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', + newIORef, + readIORef) +import qualified Data.Map.Strict as M +import qualified Data.Text as T +import Data.Time (addUTCTime, + getCurrentTime) +import System.ZMQ4 (Context) +import System.ZMQ4.ZAP (CurveCertificate) data QuoteThreadHandle = QuoteThreadHandle ThreadId ThreadId QuoteThreadEnv @@ -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 diff --git a/src/ATrade/Driver/Junction/RobotDriverThread.hs b/src/ATrade/Driver/Junction/RobotDriverThread.hs new file mode 100644 index 0000000..7a46b4d --- /dev/null +++ b/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) diff --git a/src/ATrade/Driver/Junction/Types.hs b/src/ATrade/Driver/Junction/Types.hs index bc23b80..3590cd1 100644 --- a/src/ATrade/Driver/Junction/Types.hs +++ b/src/ATrade/Driver/Junction/Types.hs @@ -8,19 +8,20 @@ module ATrade.Driver.Junction.Types StrategyDescriptor(..), TickerConfig(..), StrategyInstanceDescriptor(..), - StrategyInstance(..) - ) where + StrategyInstance(..), + 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 = - forall c s. (FromJSON s, ToJSON s, FromJSON c) => +data StrategyDescriptor c s = StrategyDescriptor { baseStrategyName :: T.Text, @@ -28,27 +29,39 @@ 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, - configKey :: T.Text, - stateKey :: T.Text, - logPath :: T.Text + strategyId :: T.Text, + strategyBaseName :: T.Text, + configKey :: T.Text, + stateKey :: T.Text, + logPath :: T.Text } deriving (Generic, Show) instance FromDhall StrategyInstanceDescriptor -data StrategyInstance = - forall c s. (FromJSON s, ToJSON s, FromJSON c) => +data StrategyInstance c s = StrategyInstance { strategyInstanceId :: T.Text, diff --git a/src/ATrade/RoboCom/ConfigStorage.hs b/src/ATrade/RoboCom/ConfigStorage.hs new file mode 100644 index 0000000..4a18ef8 --- /dev/null +++ b/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 + + diff --git a/src/ATrade/RoboCom/Monad.hs b/src/ATrade/RoboCom/Monad.hs index b9cd3be..f043279 100644 --- a/src/ATrade/RoboCom/Monad.hs +++ b/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 diff --git a/src/ATrade/RoboCom/Persistence.hs b/src/ATrade/RoboCom/Persistence.hs new file mode 100644 index 0000000..602a1fc --- /dev/null +++ b/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 + + diff --git a/src/ATrade/RoboCom/Positions.hs b/src/ATrade/RoboCom/Positions.hs index d4e74d6..4fa2443 100644 --- a/src/ATrade/RoboCom/Positions.hs +++ b/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 - maybeBars <- view (seBars . at mainTicker') <$> getEnvironment + (tf, mainTicker') <- mainTicker <$> getConfig + 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 - flip M.lookup bars . mainTicker <$> getConfig + (tf, mainTicker') <- 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,8 +417,8 @@ getAllActiveAndPendingPositions = L.filter onNewBarEvent :: (MonadRobot m c s) => Event -> (Bar -> m ()) -> m () onNewBarEvent event f = case event of - NewBar bar -> f bar - _ -> doNothing + NewBar (_, bar) -> f bar + _ -> doNothing onNewTickEvent :: (MonadRobot m c s) => Event -> (Tick -> m ()) -> m () onNewTickEvent event f = case event of @@ -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 diff --git a/src/ATrade/RoboCom/Types.hs b/src/ATrade/RoboCom/Types.hs index e5b8878..136ebcf 100644 --- a/src/ATrade/RoboCom/Types.hs +++ b/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) diff --git a/stack.yaml b/stack.yaml index ae397ab..2011e3d 100644 --- a/stack.yaml +++ b/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.