diff --git a/src/ATrade/Driver/Junction/JunctionMonad.hs b/src/ATrade/Driver/Junction/JunctionMonad.hs index 748ec51..938fbb9 100644 --- a/src/ATrade/Driver/Junction/JunctionMonad.hs +++ b/src/ATrade/Driver/Junction/JunctionMonad.hs @@ -9,7 +9,8 @@ module ATrade.Driver.Junction.JunctionMonad JunctionM(..), startRobot, saveRobots, - reloadConfig + reloadConfig, + getState ) where import ATrade.Broker.Client (BrokerClientHandle) @@ -63,6 +64,7 @@ import Control.Monad.Reader (MonadIO (liftIO), asks) import Data.Aeson (eitherDecode, encode) +import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import Data.Default (Default (def)) import Data.Foldable (traverse_) @@ -226,3 +228,15 @@ reloadConfig instId = flip catchAny (\_ -> return $ Left "Exception") $ do liftIO $ writeIORef (strategyConfig inst) (confStrategy bigConf)) return $ Right () Nothing -> return $ Left "Unable to load config" + +getState :: T.Text -> JunctionM (Either T.Text B.ByteString) +getState instId = do + robotsMap' <- asks peRobots + robots <- liftIO $ readIORef robotsMap' + case M.lookup instId robots of + Just robot -> do + Right <$> onStrategyInstanceM robot + (\inst -> do + v <- liftIO $ readIORef (strategyState inst) + return $ BL.toStrict $ encode v) + Nothing -> return $ Left $ "Unknown robot: " <> instId diff --git a/src/ATrade/Driver/Junction/RemoteControl.hs b/src/ATrade/Driver/Junction/RemoteControl.hs index 8d093b7..f00ecf9 100644 --- a/src/ATrade/Driver/Junction/RemoteControl.hs +++ b/src/ATrade/Driver/Junction/RemoteControl.hs @@ -8,7 +8,7 @@ module ATrade.Driver.Junction.RemoteControl ) where import ATrade.Driver.Junction.JunctionMonad (JunctionEnv (peLogAction, peRemoteControlSocket, peRobots), - JunctionM, + JunctionM, getState, reloadConfig, startRobot) import ATrade.Driver.Junction.RobotDriverThread (stopRobot) @@ -35,12 +35,14 @@ import UnliftIO (MonadIO (liftIO), data RemoteControlResponse = ResponseOk | ResponseError T.Text + | ResponseData B.ByteString deriving (Show, Eq) data RemoteControlRequest = StartRobot StrategyInstanceDescriptor | StopRobot T.Text | ReloadConfig T.Text + | GetState T.Text | SetState T.Text B.ByteString | Ping deriving (Show) @@ -57,6 +59,7 @@ parseRemoteControlRequest bs = | cmd == "START" -> parseStart | cmd == "STOP" -> parseStop | cmd == "RELOAD_CONFIG" -> parseReloadConfig + | cmd == "GET_STATE" -> parseGetState | cmd == "SET_STATE" -> parseSetState | cmd == "PING" -> Right Ping | otherwise -> Left UnknownCmd @@ -76,6 +79,10 @@ parseRemoteControlRequest bs = Left _ -> Left UtfDecodeError Right r -> Right (ReloadConfig (T.strip r)) + parseGetState = case decodeUtf8' (B.takeWhile (/= 0x20) rest) of + Left _ -> Left UtfDecodeError + Right r -> Right (GetState r) + parseSetState = case decodeUtf8' (B.takeWhile (/= 0x20) rest) of Left _ -> Left UtfDecodeError Right r -> Right (SetState r (B.dropWhile (== 0x20) . B.dropWhile (/= 0x20) $ rest)) @@ -84,6 +91,7 @@ parseRemoteControlRequest bs = makeRemoteControlResponse :: RemoteControlResponse -> B.ByteString makeRemoteControlResponse ResponseOk = "OK" makeRemoteControlResponse (ResponseError msg) = "ERROR " <> encodeUtf8 msg +makeRemoteControlResponse (ResponseData d) = "DATA\n" <> d handleRemoteControl :: Int -> JunctionM () handleRemoteControl timeout = do @@ -118,6 +126,11 @@ handleRemoteControl timeout = do case res of Left errmsg -> return $ ResponseError errmsg Right () -> return ResponseOk + handleRequest (GetState instId) = do + res <- getState instId + case res of + Left errmsg -> return $ ResponseError errmsg + Right d -> return $ ResponseData d handleRequest (SetState instId rawState) = undefined handleRequest Ping = return ResponseOk