asakul
/
robocom-zero
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
Browse Source

junction: RemoteControl: handle RELOAD_CONFIG command

master
Denis Tereshkin 4 years ago
parent
2d146d8a16
commit
5924e3ef70
3 changed files with 45 additions and 14 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 31
      src/ATrade/Driver/Junction/JunctionMonad.hs
  2. 7
      src/ATrade/Driver/Junction/RemoteControl.hs
  3. 21
      src/ATrade/Driver/Junction/RobotDriverThread.hs

31
src/ATrade/Driver/Junction/JunctionMonad.hs
Unescape View File

@ -8,7 +8,8 @@ module ATrade.Driver.Junction.JunctionMonad @@ -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 @@ -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 @@ -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 @@ -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_) @@ -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 @@ -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 = @@ -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 @@ -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"

7
src/ATrade/Driver/Junction/RemoteControl.hs
Unescape View File

@ -9,6 +9,7 @@ module ATrade.Driver.Junction.RemoteControl @@ -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 @@ -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

21
src/ATrade/Driver/Junction/RobotDriverThread.hs
Unescape View File

@ -13,8 +13,10 @@ module ATrade.Driver.Junction.RobotDriverThread @@ -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) @@ -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 @@ -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 @@ -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 @@ -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

Write Preview
Loading…
Cancel
Save