diff --git a/src/ATrade/Driver/Junction.hs b/src/ATrade/Driver/Junction.hs index a136ba6..f832c86 100644 --- a/src/ATrade/Driver/Junction.hs +++ b/src/ATrade/Driver/Junction.hs @@ -38,9 +38,12 @@ import ATrade.Driver.Junction.Types (StrategyDescriptor StrategyInstance (strategyInstanceId), StrategyInstanceDescriptor (..), confStrategy, + confTickers, strategyState, - strategyTimers) -import ATrade.Logging (Message, Severity (Debug, Info, Trace, Warning), + strategyTimers, + tickerId, + timeframe) +import ATrade.Logging (Message, Severity (Debug, Error, Info, Trace, Warning), fmtMessage, logWarning, logWith) @@ -48,7 +51,8 @@ import ATrade.Quotes.QHP (mkQHPHandle) import ATrade.RoboCom.ConfigStorage (ConfigStorage (loadConfig)) import ATrade.RoboCom.Monad (StrategyEnvironment (..)) import ATrade.RoboCom.Persistence (MonadPersistence (loadState, saveState)) -import ATrade.RoboCom.Types (Bars) +import ATrade.RoboCom.Types (BarSeriesId (BarSeriesId), + Bars) import ATrade.Types (ClientSecurityParams (ClientSecurityParams), OrderId, Trade (tradeOrderId)) @@ -74,6 +78,7 @@ import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef) +import Data.List.NonEmpty (NonEmpty ((:|))) import qualified Data.Map.Strict as M import Data.Set (notMember) import qualified Data.Set as S @@ -238,25 +243,30 @@ junctionMain descriptors = do 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 - rTimers <- loadState (stateKey inst <> ":timers") >>= liftIO . newIORef - localH <- liftIO $ openFile (logBasePath cfg <> "/" <> T.unpack (strategyId inst) <> ".log") AppendMode - liftIO $ hSetBuffering localH LineBuffering - let robotLogAction = logger logHandle <> (fmtMessage >$< logTextHandle localH) - stratEnv <- liftIO $ newIORef StrategyEnvironment - { - _seInstanceId = strategyId inst, - _seAccount = "test", -- TODO configure - _seVolume = 1, - _seLastTimestamp = now - } - let robotEnv = RobotEnv rState rConf rTimers barsMap stratEnv robotLogAction broService - robot <- createRobotDriverThread inst desc (flip runReaderT robotEnv . unRobotM) bigConf rConf rState rTimers - robotsMap' <- asks peRobots - liftIO $ atomicModifyIORef' robotsMap' (\s -> (M.insert (strategyId inst) robot s, ())) + case confTickers bigConf of + (firstTicker:restTickers) -> do + rConf <- liftIO $ newIORef (confStrategy bigConf) + rState <- loadState (stateKey inst) >>= liftIO . newIORef + rTimers <- loadState (stateKey inst <> ":timers") >>= liftIO . newIORef + localH <- liftIO $ openFile (logBasePath cfg <> "/" <> T.unpack (strategyId inst) <> ".log") AppendMode + liftIO $ hSetBuffering localH LineBuffering + let robotLogAction = logger logHandle <> (fmtMessage >$< logTextHandle localH) + stratEnv <- liftIO $ newIORef StrategyEnvironment + { + _seInstanceId = strategyId inst, + _seAccount = "test", -- TODO configure + _seVolume = 1, + _seLastTimestamp = now + } + let robotEnv = RobotEnv rState rConf rTimers barsMap stratEnv robotLogAction broService (toBarSeriesId <$> (firstTicker :| restTickers)) + robot <- createRobotDriverThread inst desc (flip runReaderT robotEnv . unRobotM) bigConf rConf rState rTimers + robotsMap' <- asks peRobots + liftIO $ atomicModifyIORef' robotsMap' (\s -> (M.insert (strategyId inst) robot s, ())) + _ -> logWith (logger logHandle) Error (strategyId inst) $ "No tickers configured !!!" Nothing -> error "Unknown strategy" + toBarSeriesId t = BarSeriesId (tickerId t) (timeframe t) + withJunction :: JunctionEnv -> JunctionM () -> IO () withJunction env = (`runReaderT` env) . unJunctionM diff --git a/src/ATrade/Driver/Junction/RobotDriverThread.hs b/src/ATrade/Driver/Junction/RobotDriverThread.hs index 93b3ac4..ae40d36 100644 --- a/src/ATrade/Driver/Junction/RobotDriverThread.hs +++ b/src/ATrade/Driver/Junction/RobotDriverThread.hs @@ -15,7 +15,6 @@ module ATrade.Driver.Junction.RobotDriverThread onStrategyInstance, postNotificationEvent) where -import Prelude hiding (log) import ATrade.Broker.Protocol (Notification (OrderNotification, TradeNotification)) import qualified ATrade.Driver.Junction.BrokerService as Bro import ATrade.Driver.Junction.QuoteStream (QuoteStream (addSubscription), @@ -29,8 +28,8 @@ import ATrade.Driver.Junction.Types (BigConfig, eventCallback, stateKey, strategyId, tickerId, timeframe) -import ATrade.Logging (Message, logDebug, - logInfo, logWarning, log) +import ATrade.Logging (Message, log, logDebug, + logInfo, logWarning) import ATrade.QuoteSource.Client (QuoteData (..)) import ATrade.RoboCom.ConfigStorage (ConfigStorage) import ATrade.RoboCom.Monad (Event (NewBar, NewTick, NewTrade, OrderSubmitted, OrderUpdate), @@ -57,10 +56,12 @@ import Data.Default import Data.IORef (IORef, atomicModifyIORef', readIORef, writeIORef) +import Data.List.NonEmpty (NonEmpty) import qualified Data.Map.Strict as M import qualified Data.Text.Lazy as TL import Data.Time (UTCTime, getCurrentTime) import Dhall (FromDhall) +import Prelude hiding (log) data RobotDriverHandle = forall c s. (FromDhall c, Default s, FromJSON s, ToJSON s) => RobotDriverHandle (StrategyInstance c s) ThreadId ThreadId (BoundedChan RobotDriverEvent) @@ -140,7 +141,8 @@ data RobotEnv c s = bars :: IORef Bars, env :: IORef StrategyEnvironment, logAction :: LogAction (RobotM c s) Message, - brokerService :: Bro.BrokerService + brokerService :: Bro.BrokerService, + tickers :: NonEmpty BarSeriesId } newtype RobotM c s a = RobotM { unRobotM :: ReaderT (RobotEnv c s) IO a } @@ -181,6 +183,8 @@ instance MonadRobot (RobotM c s) c s where b <- asks bars >>= liftIO . readIORef return $ M.lookup (BarSeriesId tid tf) b + getAvailableTickers = asks tickers + postNotificationEvent :: (MonadIO m) => RobotDriverHandle -> Notification -> m () postNotificationEvent (RobotDriverHandle _ _ _ eventQueue) notification = liftIO $ case notification of diff --git a/src/ATrade/RoboCom/Monad.hs b/src/ATrade/RoboCom/Monad.hs index 399d16c..c30c18c 100644 --- a/src/ATrade/RoboCom/Monad.hs +++ b/src/ATrade/RoboCom/Monad.hs @@ -19,8 +19,8 @@ module ATrade.RoboCom.Monad ( MonadRobot(..), also, t, - st -) where + st, + getFirstTickerId) where import ATrade.RoboCom.Types import ATrade.Types @@ -33,6 +33,8 @@ import Data.Time.Clock import Language.Haskell.Printf import Language.Haskell.TH.Quote (QuasiQuoter) import ATrade.Logging (Severity) +import Data.List.NonEmpty (NonEmpty) +import qualified Data.List.NonEmpty as NE class (Monad m) => MonadRobot m c s | m -> c, m -> s where submitOrder :: Order -> m OrderId @@ -49,6 +51,10 @@ class (Monad m) => MonadRobot m c s | m -> c, m -> s where setState (f oldState) getEnvironment :: m StrategyEnvironment getTicker :: TickerId -> BarTimeframe -> m (Maybe BarSeries) + getAvailableTickers :: m (NonEmpty BarSeriesId) + +getFirstTickerId :: forall c s m. (Monad m, MonadRobot m c s) => m BarSeriesId +getFirstTickerId = NE.head <$> getAvailableTickers st :: QuasiQuoter st = t diff --git a/src/ATrade/RoboCom/Positions.hs b/src/ATrade/RoboCom/Positions.hs index 4d9f1ad..c71d8bf 100644 --- a/src/ATrade/RoboCom/Positions.hs +++ b/src/ATrade/RoboCom/Positions.hs @@ -20,7 +20,6 @@ module ATrade.RoboCom.Positions ( StateHasPositions(..), - ParamsHasMainTicker(..), PositionState(..), Position(..), posIsOpen, @@ -79,8 +78,10 @@ import Control.Lens import Control.Monad import ATrade.Logging (Severity (Trace, Warning)) +import ATrade.RoboCom.Monad (MonadRobot (getAvailableTickers)) import Data.Aeson import qualified Data.List as L +import qualified Data.List.NonEmpty as NE import qualified Data.Text as T import qualified Data.Text.Lazy as TL import Data.Time.Clock @@ -389,17 +390,17 @@ modifyPosition f oldpos = do return $ f oldpos Nothing -> return oldpos -getCurrentTicker :: (ParamsHasMainTicker c, MonadRobot m c s) => m [Bar] +getCurrentTicker :: (MonadRobot m c s) => m [Bar] getCurrentTicker = do - (tf, mainTicker') <- mainTicker <$> getConfig + (BarSeriesId mainTicker' tf) <- NE.head <$> getAvailableTickers maybeBars <- getTicker mainTicker' tf case maybeBars of Just b -> return $ bsBars b _ -> return [] -getCurrentTickerSeries :: (ParamsHasMainTicker c, MonadRobot m c s) => m (Maybe BarSeries) +getCurrentTickerSeries :: (MonadRobot m c s) => m (Maybe BarSeries) getCurrentTickerSeries = do - (tf, mainTicker') <- mainTicker <$> getConfig + (BarSeriesId mainTicker' tf) <- NE.head <$> getAvailableTickers getTicker mainTicker' tf getLastActivePosition :: (StateHasPositions s, MonadRobot m c s) => m (Maybe Position) @@ -460,14 +461,14 @@ onActionCompletedEvent event f = case event of ActionCompleted tag v -> f tag v _ -> doNothing -enterAtMarket :: (StateHasPositions s, ParamsHasMainTicker c, MonadRobot m c s) => T.Text -> Operation -> m Position +enterAtMarket :: (StateHasPositions s, MonadRobot m c s) => T.Text -> Operation -> m Position enterAtMarket operationSignalName operation = do env <- getEnvironment enterAtMarketWithParams (env ^. seAccount) (env ^. seVolume) (SignalId (env ^. seInstanceId) operationSignalName "") operation -enterAtMarketWithParams :: (StateHasPositions s, ParamsHasMainTicker c, MonadRobot m c s) => T.Text -> Int -> SignalId -> Operation -> m Position +enterAtMarketWithParams :: (StateHasPositions s, MonadRobot m c s) => T.Text -> Int -> SignalId -> Operation -> m Position enterAtMarketWithParams account quantity signalId operation = do - tickerId <- snd . mainTicker <$> getConfig + BarSeriesId tickerId _ <- getFirstTickerId oid <- submitOrder $ order tickerId newPosition ((order tickerId) { orderId = oid }) account tickerId operation quantity 20 where @@ -480,20 +481,20 @@ enterAtMarketWithParams account quantity signalId operation = do orderSignalId = signalId } -enterAtLimit :: (StateHasPositions s, ParamsHasMainTicker c, MonadRobot m c s) => NominalDiffTime -> T.Text -> Price -> Operation -> m Position +enterAtLimit :: (StateHasPositions s, MonadRobot m c s) => NominalDiffTime -> T.Text -> Price -> Operation -> m Position enterAtLimit timeToCancel operationSignalName price operation = do env <- getEnvironment enterAtLimitWithParams timeToCancel (env ^. seAccount) (env ^. seVolume) (SignalId (env ^. seInstanceId) operationSignalName "") price operation -enterAtLimitWithVolume :: (StateHasPositions s, ParamsHasMainTicker c, MonadRobot m c s) => NominalDiffTime -> T.Text -> Price -> Int -> Operation -> m Position +enterAtLimitWithVolume :: (StateHasPositions s, MonadRobot m c s) => NominalDiffTime -> T.Text -> Price -> Int -> Operation -> m Position enterAtLimitWithVolume timeToCancel operationSignalName price vol operation = do acc <- view seAccount <$> getEnvironment inst <- view seInstanceId <$> getEnvironment enterAtLimitWithParams timeToCancel acc vol (SignalId inst operationSignalName "") price operation -enterAtLimitWithParams :: (StateHasPositions s, ParamsHasMainTicker c, MonadRobot m c s) => NominalDiffTime -> T.Text -> Int -> SignalId -> Price -> Operation -> m Position +enterAtLimitWithParams :: (StateHasPositions s, MonadRobot m c s) => NominalDiffTime -> T.Text -> Int -> SignalId -> Price -> Operation -> m Position enterAtLimitWithParams timeToCancel account quantity signalId price operation = do - tickerId <- snd . mainTicker <$> getConfig + BarSeriesId tickerId _ <- getFirstTickerId enterAtLimitForTickerWithParams tickerId timeToCancel account quantity signalId price operation enterAtLimitForTickerWithVolume :: (StateHasPositions s, MonadRobot m c s) => TickerId -> NominalDiffTime -> T.Text -> Price -> Int -> Operation -> m Position @@ -526,19 +527,19 @@ enterAtLimitForTickerWithParams tickerId timeToCancel account quantity signalId orderSignalId = signalId } -enterLongAtMarket :: (StateHasPositions s, ParamsHasMainTicker c, MonadRobot m c s) => T.Text -> m Position +enterLongAtMarket :: (StateHasPositions s, MonadRobot m c s) => T.Text -> m Position enterLongAtMarket operationSignalName = enterAtMarket operationSignalName Buy -enterShortAtMarket :: (StateHasPositions s, ParamsHasMainTicker c, MonadRobot m c s) => T.Text -> m Position +enterShortAtMarket :: (StateHasPositions s, MonadRobot m c s) => T.Text -> m Position enterShortAtMarket operationSignalName = enterAtMarket operationSignalName Sell -enterLongAtLimit :: (StateHasPositions s, ParamsHasMainTicker c, MonadRobot m c s) => NominalDiffTime -> Price -> T.Text -> m Position +enterLongAtLimit :: (StateHasPositions s, MonadRobot m c s) => NominalDiffTime -> Price -> T.Text -> m Position enterLongAtLimit timeToCancel price operationSignalName = enterAtLimit timeToCancel operationSignalName price Buy enterLongAtLimitForTicker :: (StateHasPositions s, MonadRobot m c s) => TickerId -> NominalDiffTime -> Price -> T.Text -> m Position enterLongAtLimitForTicker tickerId timeToCancel price operationSignalName = enterAtLimitForTicker tickerId timeToCancel operationSignalName price Buy -enterShortAtLimit :: (StateHasPositions s, ParamsHasMainTicker c, MonadRobot m c s) => NominalDiffTime -> Price -> T.Text -> m Position +enterShortAtLimit :: (StateHasPositions s, MonadRobot m c s) => NominalDiffTime -> Price -> T.Text -> m Position enterShortAtLimit timeToCancel price operationSignalName = enterAtLimit timeToCancel operationSignalName price Sell enterShortAtLimitForTicker :: (StateHasPositions s, MonadRobot m c s) => TickerId -> NominalDiffTime -> Price -> T.Text -> m Position