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

Junction: handle robot stop command

master
Denis Tereshkin 4 years ago
parent
a245a01a66
commit
4ac71e148c
3 changed files with 61 additions and 34 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Unified View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 4
      src/ATrade/Driver/Junction/JunctionMonad.hs
  2. 51
      src/ATrade/Driver/Junction/RemoteControl.hs
  3. 40
      src/ATrade/Driver/Junction/RobotDriverThread.hs

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

@ -141,7 +141,9 @@ instance QuoteStream JunctionM where
addSubscription (QuoteSubscription ticker tf) chan = do addSubscription (QuoteSubscription ticker tf) chan = do
qt <- asks peQuoteThread qt <- asks peQuoteThread
QT.addSubscription qt ticker tf chan QT.addSubscription qt ticker tf chan
removeSubscription _ = undefined removeSubscription subId = do
qt <- asks peQuoteThread
QT.removeSubscription qt subId
startRobot :: LogAction IO Message -> ProgramConfiguration -> IORef Bars -> IORef TickerInfoMap -> startRobot :: LogAction IO Message -> ProgramConfiguration -> IORef Bars -> IORef TickerInfoMap ->
BrokerService -> M.Map T.Text StrategyDescriptorE -> StrategyInstanceDescriptor -> JunctionM () BrokerService -> M.Map T.Text StrategyDescriptorE -> StrategyInstanceDescriptor -> JunctionM ()

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

@ -1,3 +1,4 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
@ -6,21 +7,28 @@ module ATrade.Driver.Junction.RemoteControl
handleRemoteControl handleRemoteControl
) where ) where
import ATrade.Driver.Junction.JunctionMonad (JunctionEnv (peLogAction, peRemoteControlSocket, peRobots), import ATrade.Driver.Junction.JunctionMonad (JunctionEnv (peLogAction, peRemoteControlSocket, peRobots),
JunctionM) JunctionM)
import ATrade.Driver.Junction.Types (StrategyInstanceDescriptor) import ATrade.Driver.Junction.RobotDriverThread (stopRobot)
import ATrade.Logging (logErrorWith) import ATrade.Driver.Junction.Types (StrategyInstanceDescriptor)
import Control.Monad (unless) import ATrade.Logging (Severity (Info),
import Control.Monad.Reader (asks) logErrorWith,
import Data.Aeson (decode) logWith)
import qualified Data.ByteString as B import Control.Monad (unless)
import qualified Data.ByteString.Lazy as BL import Control.Monad.Reader (asks)
import qualified Data.Map.Strict as M import Data.Aeson (decode)
import qualified Data.Text as T import qualified Data.ByteString as B
import Data.Text.Encoding (decodeUtf8', encodeUtf8) import qualified Data.ByteString.Lazy as BL
import System.ZMQ4 (Event (In), Poll (Sock), import qualified Data.Map.Strict as M
poll, receive, send) import qualified Data.Text as T
import UnliftIO (MonadIO (liftIO)) import Data.Text.Encoding (decodeUtf8',
encodeUtf8)
import System.ZMQ4 (Event (In),
Poll (Sock), poll,
receive, send)
import UnliftIO (MonadIO (liftIO),
atomicModifyIORef',
readIORef)
data RemoteControlResponse = data RemoteControlResponse =
ResponseOk ResponseOk
@ -89,7 +97,18 @@ handleRemoteControl timeout = do
liftIO $ send sock [] (makeRemoteControlResponse response) liftIO $ send sock [] (makeRemoteControlResponse response)
where where
handleRequest (StartRobot inst) = undefined handleRequest (StartRobot inst) = undefined
handleRequest (StopRobot instId) = undefined handleRequest (StopRobot instId) = do
robotsRef <- asks peRobots
robots <- readIORef robotsRef
case M.lookup instId robots of
Just robot -> do
logger <- asks peLogAction
logWith logger Info "RemoteControl" $ "Stopping robot: " <> instId
stopRobot robot
liftIO $ atomicModifyIORef' robotsRef (\r -> (M.delete instId r, ()))
return ResponseOk
Nothing -> return $ ResponseError $ "Not started: " <> instId
handleRequest (ReloadConfig instId) = undefined handleRequest (ReloadConfig instId) = undefined
handleRequest (SetState instId rawState) = undefined handleRequest (SetState instId rawState) = undefined
handleRequest Ping = return ResponseOk handleRequest Ping = return ResponseOk

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

@ -13,12 +13,14 @@ module ATrade.Driver.Junction.RobotDriverThread
RobotM(..), RobotM(..),
RobotDriverHandle, RobotDriverHandle,
onStrategyInstance, onStrategyInstance,
postNotificationEvent) where postNotificationEvent,
stopRobot
) where
import ATrade.Broker.Protocol (Notification (OrderNotification, TradeNotification)) import ATrade.Broker.Protocol (Notification (OrderNotification, TradeNotification))
import qualified ATrade.Driver.Junction.BrokerService as Bro import qualified ATrade.Driver.Junction.BrokerService as Bro
import ATrade.Driver.Junction.QuoteStream (QuoteStream (addSubscription), import ATrade.Driver.Junction.QuoteStream (QuoteStream (addSubscription, removeSubscription),
QuoteSubscription (QuoteSubscription)) QuoteSubscription (QuoteSubscription), SubscriptionId)
import ATrade.Driver.Junction.Types (BigConfig, import ATrade.Driver.Junction.Types (BigConfig,
StrategyDescriptor, StrategyDescriptor,
StrategyInstance (StrategyInstance, strategyEventCallback), StrategyInstance (StrategyInstance, strategyEventCallback),
@ -28,31 +30,29 @@ import ATrade.Driver.Junction.Types (BigConfig,
eventCallback, stateKey, eventCallback, stateKey,
strategyId, tickerId, strategyId, tickerId,
timeframe) timeframe)
import ATrade.Logging (Message, log, logDebug, import ATrade.Logging (Message, log)
logInfo, logWarning)
import ATrade.QuoteSource.Client (QuoteData (..)) import ATrade.QuoteSource.Client (QuoteData (..))
import ATrade.RoboCom.ConfigStorage (ConfigStorage) import ATrade.RoboCom.ConfigStorage (ConfigStorage)
import ATrade.RoboCom.Monad (Event (NewBar, NewTick, NewTrade, OrderSubmitted, OrderUpdate), import ATrade.RoboCom.Monad (Event (NewBar, NewTick, NewTrade, OrderUpdate),
MonadRobot (..), MonadRobot (..), StrategyEnvironment (..))
StrategyEnvironment (StrategyEnvironment, _seInstanceId, _seLastTimestamp))
import ATrade.RoboCom.Persistence (MonadPersistence) import ATrade.RoboCom.Persistence (MonadPersistence)
import ATrade.RoboCom.Types (BarSeriesId (BarSeriesId), import ATrade.RoboCom.Types (BarSeriesId (BarSeriesId),
Bars, TickerInfoMap) Bars, TickerInfoMap)
import ATrade.Types (Order (orderId), OrderId, import ATrade.Types (OrderId,
OrderState, Trade, Tick (value)) OrderState, Trade, Tick (value))
import Colog (HasLog (getLogAction, setLogAction), import Colog (HasLog (getLogAction, setLogAction),
LogAction) LogAction)
import Control.Concurrent (ThreadId, forkIO) import Control.Concurrent (ThreadId, forkIO, killThread)
import Control.Concurrent.BoundedChan (BoundedChan, import Control.Concurrent.BoundedChan (BoundedChan,
newBoundedChan, readChan, newBoundedChan, readChan,
writeChan) writeChan)
import Control.Exception.Safe (MonadThrow) import Control.Exception.Safe (MonadThrow)
import Control.Monad (forM_, forever, void, when) import Control.Monad (forM_, forever, void, when, forM)
import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Reader (MonadReader (local), import Control.Monad.Reader (MonadReader (local),
ReaderT, asks) ReaderT, asks)
import Data.Aeson (FromJSON, ToJSON) import Data.Aeson (FromJSON, ToJSON)
import Data.Default import Data.Default ( Default )
import Data.IORef (IORef, import Data.IORef (IORef,
atomicModifyIORef', atomicModifyIORef',
readIORef, writeIORef) readIORef, writeIORef)
@ -64,7 +64,7 @@ import Dhall (FromDhall)
import Prelude hiding (log) import Prelude hiding (log)
data RobotDriverHandle = forall c s. (FromDhall c, Default s, FromJSON s, ToJSON s) => data RobotDriverHandle = forall c s. (FromDhall c, Default s, FromJSON s, ToJSON s) =>
RobotDriverHandle (StrategyInstance c s) ThreadId ThreadId (BoundedChan RobotDriverEvent) RobotDriverHandle (StrategyInstance c s) ThreadId ThreadId (BoundedChan RobotDriverEvent) [SubscriptionId]
data RobotDriverRequest data RobotDriverRequest
@ -118,19 +118,25 @@ createRobotDriverThread instDesc strDesc runner bigConf rConf rState rTimers = d
let inst = StrategyInstance (strategyId instDesc) (eventCallback strDesc) rState rConf rTimers let inst = StrategyInstance (strategyId instDesc) (eventCallback strDesc) rState rConf rTimers
quoteQueue <- liftIO $ newBoundedChan 2000 quoteQueue <- liftIO $ newBoundedChan 2000
forM_ (confTickers bigConf) (\x -> addSubscription (QuoteSubscription (tickerId x) (timeframe x)) quoteQueue) subIds <- forM (confTickers bigConf) (\x -> addSubscription (QuoteSubscription (tickerId x) (timeframe x)) quoteQueue)
qthread <- liftIO . forkIO $ forever $ passQuoteEvents eventQueue quoteQueue qthread <- liftIO . forkIO $ forever $ passQuoteEvents eventQueue quoteQueue
driver <- liftIO . forkIO $ runner $ robotDriverThread inst eventQueue driver <- liftIO . forkIO $ runner $ robotDriverThread inst eventQueue
return $ RobotDriverHandle inst driver qthread eventQueue return $ RobotDriverHandle inst driver qthread eventQueue subIds
where where
passQuoteEvents eventQueue quoteQueue = do passQuoteEvents eventQueue quoteQueue = do
v <- readChan quoteQueue v <- readChan quoteQueue
writeChan eventQueue (QuoteEvent v) writeChan eventQueue (QuoteEvent v)
stopRobot :: (MonadIO m, QuoteStream m) => RobotDriverHandle -> m ()
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 -> 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
data RobotEnv c s = data RobotEnv c s =
RobotEnv RobotEnv
@ -191,7 +197,7 @@ instance MonadRobot (RobotM c s) c s where
getAvailableTickers = asks tickers getAvailableTickers = asks tickers
postNotificationEvent :: (MonadIO m) => RobotDriverHandle -> Notification -> m () postNotificationEvent :: (MonadIO m) => RobotDriverHandle -> Notification -> m ()
postNotificationEvent (RobotDriverHandle _ _ _ eventQueue) notification = liftIO $ postNotificationEvent (RobotDriverHandle _ _ _ eventQueue _) notification = liftIO $
case notification of case notification of
OrderNotification _ oid state -> writeChan eventQueue (OrderEvent oid state) OrderNotification _ oid state -> writeChan eventQueue (OrderEvent oid state)
TradeNotification _ trade -> writeChan eventQueue (NewTradeEvent trade) TradeNotification _ trade -> writeChan eventQueue (NewTradeEvent trade)

Write Preview
Loading…
Cancel
Save