diff --git a/src/ATrade/Driver/Junction/JunctionMonad.hs b/src/ATrade/Driver/Junction/JunctionMonad.hs index e4ac629..748ec51 100644 --- a/src/ATrade/Driver/Junction/JunctionMonad.hs +++ b/src/ATrade/Driver/Junction/JunctionMonad.hs @@ -8,7 +8,8 @@ module ATrade.Driver.Junction.JunctionMonad JunctionEnv(..), JunctionM(..), startRobot, - saveRobots + saveRobots, + reloadConfig ) where import ATrade.Broker.Client (BrokerClientHandle) @@ -22,7 +23,9 @@ import qualified ATrade.Driver.Junction.QuoteThread as QT import ATrade.Driver.Junction.RobotDriverThread (RobotDriverHandle, RobotEnv (RobotEnv), RobotM (unRobotM), createRobotDriverThread, - onStrategyInstance) + getInstanceDescriptor, + onStrategyInstance, + onStrategyInstanceM) import ATrade.Driver.Junction.Types (StrategyDescriptorE (StrategyDescriptorE), StrategyInstanceDescriptor, accountId, @@ -31,6 +34,7 @@ import ATrade.Driver.Junction.Types (StrategyDescriptor configKey, stateKey, strategyBaseName, + strategyConfig, strategyId, strategyInstanceId, strategyState, @@ -52,7 +56,6 @@ import Colog (HasLog (getLogActi hoistLogAction, logTextHandle, (>$<)) -import Control.Exception.Safe (MonadThrow) import Control.Exception.Safe (finally) import Control.Monad.Reader (MonadIO (liftIO), MonadReader, @@ -66,7 +69,8 @@ import Data.Foldable (traverse_) import Data.IORef (IORef, atomicModifyIORef', newIORef, - readIORef) + readIORef, + writeIORef) import Data.List.NonEmpty (NonEmpty ((:|))) import qualified Data.Map.Strict as M import qualified Data.Text as T @@ -86,7 +90,8 @@ import System.IO (BufferMode (LineBu import System.IO (hClose) import System.ZMQ4 (Rep, Socket) import UnliftIO (MonadUnliftIO) -import UnliftIO.Exception (catchAny) +import UnliftIO.Exception (catchAny, + onException) data JunctionEnv = JunctionEnv @@ -107,7 +112,7 @@ data JunctionEnv = } newtype JunctionM a = JunctionM { unJunctionM :: ReaderT JunctionEnv IO a } - deriving (Functor, Applicative, Monad, MonadReader JunctionEnv, MonadIO, MonadThrow, MonadUnliftIO) + deriving (Functor, Applicative, Monad, MonadReader JunctionEnv, MonadIO, MonadUnliftIO) instance HasLog JunctionEnv Message JunctionM where getLogAction = peLogAction @@ -207,3 +212,17 @@ saveRobotState handle = onStrategyInstance handle $ \inst -> do saveState currentState (strategyInstanceId inst) currentTimers <- liftIO $ readIORef (strategyTimers inst) saveState currentTimers (strategyInstanceId inst <> ":timers") + +reloadConfig :: T.Text -> JunctionM (Either T.Text ()) +reloadConfig instId = flip catchAny (\_ -> return $ Left "Exception") $ do + robotsMap' <- asks peRobots + robots <- liftIO $ readIORef robotsMap' + case M.lookup instId robots of + Just robot -> do + onStrategyInstanceM robot + (\inst -> do + let instDesc = getInstanceDescriptor robot + bigConf <- loadConfig (configKey instDesc) + liftIO $ writeIORef (strategyConfig inst) (confStrategy bigConf)) + return $ Right () + Nothing -> return $ Left "Unable to load config" diff --git a/src/ATrade/Driver/Junction/RemoteControl.hs b/src/ATrade/Driver/Junction/RemoteControl.hs index 95d3f24..8d093b7 100644 --- a/src/ATrade/Driver/Junction/RemoteControl.hs +++ b/src/ATrade/Driver/Junction/RemoteControl.hs @@ -9,6 +9,7 @@ module ATrade.Driver.Junction.RemoteControl import ATrade.Driver.Junction.JunctionMonad (JunctionEnv (peLogAction, peRemoteControlSocket, peRobots), JunctionM, + reloadConfig, startRobot) import ATrade.Driver.Junction.RobotDriverThread (stopRobot) import ATrade.Driver.Junction.Types (StrategyInstanceDescriptor) @@ -112,7 +113,11 @@ handleRemoteControl timeout = do return ResponseOk Nothing -> return $ ResponseError $ "Not started: " <> instId - handleRequest (ReloadConfig instId) = undefined + handleRequest (ReloadConfig instId) = do + res <- reloadConfig instId + case res of + Left errmsg -> return $ ResponseError errmsg + Right () -> return ResponseOk handleRequest (SetState instId rawState) = undefined handleRequest Ping = return ResponseOk diff --git a/src/ATrade/Driver/Junction/RobotDriverThread.hs b/src/ATrade/Driver/Junction/RobotDriverThread.hs index 2f18599..f3ff50c 100644 --- a/src/ATrade/Driver/Junction/RobotDriverThread.hs +++ b/src/ATrade/Driver/Junction/RobotDriverThread.hs @@ -13,8 +13,10 @@ module ATrade.Driver.Junction.RobotDriverThread RobotM(..), RobotDriverHandle, onStrategyInstance, + onStrategyInstanceM, postNotificationEvent, - stopRobot + stopRobot, + getInstanceDescriptor ) where import ATrade.Broker.Protocol (Notification (OrderNotification, TradeNotification)) @@ -68,7 +70,7 @@ 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) [SubscriptionId] + RobotDriverHandle StrategyInstanceDescriptor (StrategyInstance c s) ThreadId ThreadId (BoundedChan RobotDriverEvent) [SubscriptionId] data RobotDriverRequest @@ -126,7 +128,7 @@ createRobotDriverThread instDesc strDesc runner bigConf rConf rState rTimers = d qthread <- liftIO . forkIO $ forever $ passQuoteEvents eventQueue quoteQueue driver <- liftIO . forkIO $ runner $ robotDriverThread inst eventQueue - return $ RobotDriverHandle inst driver qthread eventQueue subIds + return $ RobotDriverHandle instDesc inst driver qthread eventQueue subIds where passQuoteEvents eventQueue quoteQueue = do @@ -134,13 +136,17 @@ createRobotDriverThread instDesc strDesc runner bigConf rConf rState rTimers = d writeChan eventQueue (QuoteEvent v) stopRobot :: (MonadIO m, QuoteStream m) => RobotDriverHandle -> m () -stopRobot (RobotDriverHandle _ driver qthread _ subIds) = do +stopRobot (RobotDriverHandle _ _ driver qthread _ subIds) = do forM_ subIds removeSubscription liftIO $ killThread driver liftIO $ killThread qthread onStrategyInstance :: RobotDriverHandle -> forall r. (forall c s. (FromDhall c, Default s, FromJSON s, ToJSON s) => StrategyInstance c s -> r) -> r -onStrategyInstance (RobotDriverHandle inst _ _ _ _) f = f inst +onStrategyInstance (RobotDriverHandle _ inst _ _ _ _) f = f inst + +onStrategyInstanceM :: (MonadIO m) => RobotDriverHandle -> + (forall c s. (FromDhall c, Default s, FromJSON s, ToJSON s) => StrategyInstance c s -> m r) -> m r +onStrategyInstanceM (RobotDriverHandle _ inst _ _ _ _) f = f inst data RobotEnv c s = RobotEnv @@ -201,9 +207,10 @@ instance MonadRobot (RobotM c s) c s where getAvailableTickers = asks tickers postNotificationEvent :: (MonadIO m) => RobotDriverHandle -> Notification -> m () -postNotificationEvent (RobotDriverHandle _ _ _ eventQueue _) notification = liftIO $ +postNotificationEvent (RobotDriverHandle _ _ _ _ eventQueue _) notification = liftIO $ case notification of OrderNotification _ oid state -> writeChan eventQueue (OrderEvent oid state) TradeNotification _ trade -> writeChan eventQueue (NewTradeEvent trade) - +getInstanceDescriptor :: RobotDriverHandle -> StrategyInstanceDescriptor +getInstanceDescriptor (RobotDriverHandle instDesc _ _ _ _ _) = instDesc