diff --git a/src/ATrade/Driver/Junction/JunctionMonad.hs b/src/ATrade/Driver/Junction/JunctionMonad.hs index 938fbb9..b8f87ac 100644 --- a/src/ATrade/Driver/Junction/JunctionMonad.hs +++ b/src/ATrade/Driver/Junction/JunctionMonad.hs @@ -10,7 +10,8 @@ module ATrade.Driver.Junction.JunctionMonad startRobot, saveRobots, reloadConfig, - getState + getState, + setState ) where import ATrade.Broker.Client (BrokerClientHandle) @@ -62,7 +63,8 @@ import Control.Monad.Reader (MonadIO (liftIO), MonadReader, ReaderT (runReaderT), asks) -import Data.Aeson (eitherDecode, +import Data.Aeson (decode, + eitherDecode, encode) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL @@ -240,3 +242,18 @@ getState instId = do v <- liftIO $ readIORef (strategyState inst) return $ BL.toStrict $ encode v) Nothing -> return $ Left $ "Unknown robot: " <> instId + +setState :: T.Text -> B.ByteString -> JunctionM (Either T.Text ()) +setState instId newState = do + robotsMap' <- asks peRobots + robots <- liftIO $ readIORef robotsMap' + case M.lookup instId robots of + Just robot -> do + onStrategyInstanceM robot + (\inst -> do + case decode . BL.fromStrict $ newState of + Just newS -> do + liftIO $ writeIORef (strategyState inst) newS + return $ Right () + Nothing -> return $ Left $ "Unable to decode state for " <> instId) + Nothing -> return $ Left $ "Unknown robot: " <> instId diff --git a/src/ATrade/Driver/Junction/RemoteControl.hs b/src/ATrade/Driver/Junction/RemoteControl.hs index b7e93bb..2a5fa94 100644 --- a/src/ATrade/Driver/Junction/RemoteControl.hs +++ b/src/ATrade/Driver/Junction/RemoteControl.hs @@ -10,7 +10,7 @@ module ATrade.Driver.Junction.RemoteControl import ATrade.Driver.Junction.JunctionMonad (JunctionEnv (peLogAction, peRemoteControlSocket, peRobots), JunctionM, getState, reloadConfig, - startRobot) + setState, startRobot) import ATrade.Driver.Junction.RobotDriverThread (stopRobot) import ATrade.Driver.Junction.Types (StrategyInstanceDescriptor) import ATrade.Logging (Severity (Info), @@ -128,12 +128,19 @@ 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 (SetState instId rawState) = do + res <- setState instId rawState + case res of + Left errmsg -> return $ ResponseError errmsg + Right () -> return ResponseOk + handleRequest Ping = return ResponseOk