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

junction: correct order submission

junction
Denis Tereshkin 4 years ago
parent
632ca49d15
commit
b1993cc349
6 changed files with 179 additions and 85 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. 1
      robocom-zero.cabal
  2. 52
      src/ATrade/Driver/Junction.hs
  3. 56
      src/ATrade/Driver/Junction/BrokerService.hs
  4. 114
      src/ATrade/Driver/Junction/RobotDriverThread.hs
  5. 2
      src/ATrade/RoboCom/Monad.hs
  6. 39
      src/ATrade/RoboCom/Positions.hs

1
robocom-zero.cabal
Unescape View File

@ -34,6 +34,7 @@ library
, ATrade.Driver.Junction.QuoteStream , ATrade.Driver.Junction.QuoteStream
, ATrade.Driver.Junction.RobotDriverThread , ATrade.Driver.Junction.RobotDriverThread
, ATrade.Driver.Junction.ProgramConfiguration , ATrade.Driver.Junction.ProgramConfiguration
, ATrade.Driver.Junction.BrokerService
, ATrade.BarAggregator , ATrade.BarAggregator
, ATrade.RoboCom , ATrade.RoboCom
, ATrade.Quotes.HistoryProvider , ATrade.Quotes.HistoryProvider

52
src/ATrade/Driver/Junction.hs
Unescape View File

@ -17,7 +17,9 @@ import ATrade.Broker.Client (BrokerClientHandle
import ATrade.Broker.Protocol (Notification (OrderNotification, TradeNotification), import ATrade.Broker.Protocol (Notification (OrderNotification, TradeNotification),
NotificationSqnum, NotificationSqnum,
getNotificationSqnum) getNotificationSqnum)
import ATrade.Driver.Junction.ProgramConfiguration (ProgramConfiguration (brokerClientCert, brokerEndpoint, brokerNotificationEndpoint, brokerServerCert, instances, qhpEndpoint, qtisEndpoint, redisSocket, robotsConfigsPath), import ATrade.Driver.Junction.BrokerService (BrokerService,
mkBrokerService)
import ATrade.Driver.Junction.ProgramConfiguration (ProgramConfiguration (ProgramConfiguration, brokerClientCert, brokerEndpoint, brokerNotificationEndpoint, brokerServerCert, instances, qhpEndpoint, qtisEndpoint, redisSocket, robotsConfigsPath),
ProgramOptions (ProgramOptions, configPath)) ProgramOptions (ProgramOptions, configPath))
import ATrade.Driver.Junction.QuoteStream (QuoteStream (addSubscription, removeSubscription), import ATrade.Driver.Junction.QuoteStream (QuoteStream (addSubscription, removeSubscription),
QuoteSubscription (QuoteSubscription), QuoteSubscription (QuoteSubscription),
@ -38,16 +40,17 @@ import ATrade.Driver.Junction.Types (StrategyDescriptor
confStrategy, confStrategy,
strategyState, strategyState,
strategyTimers) strategyTimers)
import ATrade.Logging (Message, import ATrade.Logging (Message, Severity (Debug, Error, Info, Trace, Warning),
Severity (Info),
fmtMessage, fmtMessage,
logWarning, logWarning,
logWith) logWith)
import ATrade.Quotes.QHP (mkQHPHandle) import ATrade.Quotes.QHP (mkQHPHandle)
import ATrade.RoboCom.ConfigStorage (ConfigStorage (loadConfig)) import ATrade.RoboCom.ConfigStorage (ConfigStorage (loadConfig))
import ATrade.RoboCom.Monad (StrategyEnvironment (..))
import ATrade.RoboCom.Persistence (MonadPersistence (loadState, saveState)) import ATrade.RoboCom.Persistence (MonadPersistence (loadState, saveState))
import ATrade.RoboCom.Types (Bars)
import ATrade.Types (ClientSecurityParams (ClientSecurityParams), import ATrade.Types (ClientSecurityParams (ClientSecurityParams),
OrderId, Order, OrderId,
Trade (tradeOrderId)) Trade (tradeOrderId))
import Colog (HasLog (getLogAction, setLogAction), import Colog (HasLog (getLogAction, setLogAction),
LogAction, LogAction,
@ -76,6 +79,7 @@ import qualified Data.Set as S
import qualified Data.Text as T import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8) import Data.Text.Encoding (encodeUtf8)
import Data.Text.IO (readFile) import Data.Text.IO (readFile)
import Data.Time (getCurrentTime)
import Data.Time.Clock.POSIX (getPOSIXTime) import Data.Time.Clock.POSIX (getPOSIXTime)
import Database.Redis (ConnectInfo (..), import Database.Redis (ConnectInfo (..),
Connection, Connection,
@ -162,8 +166,8 @@ junctionMain :: M.Map T.Text StrategyDescriptorE -> IO ()
junctionMain descriptors = do junctionMain descriptors = do
opts <- parseOptions opts <- parseOptions
let bootstrapLogAction = fmtMessage >$< logTextStdout let logger = fmtMessage >$< logTextStdout
let log = logWith bootstrapLogAction let log = logWith logger
log Info "Junction" $ "Reading config from: " <> (T.pack . show) (configPath opts) log Info "Junction" $ "Reading config from: " <> (T.pack . show) (configPath opts)
@ -171,15 +175,19 @@ junctionMain descriptors = do
barsMap <- newIORef M.empty barsMap <- newIORef M.empty
log Info "Junction" $ "Connecting to redis: " <> redisSocket cfg
redis <- checkedConnect (defaultConnectInfo { connectPort = UnixSocket (T.unpack $ redisSocket cfg) }) redis <- checkedConnect (defaultConnectInfo { connectPort = UnixSocket (T.unpack $ redisSocket cfg) })
log Info "Junction" "redis: connected"
withContext $ \ctx -> do withContext $ \ctx -> do
log Debug "Junction" "0mq context created"
let downloaderLogAction = fmtMessage >$< logTextStdout let downloaderLogAction = fmtMessage >$< logTextStdout
let downloaderEnv = DownloaderEnv (mkQHPHandle ctx (qhpEndpoint cfg)) ctx (qtisEndpoint cfg) downloaderLogAction let downloaderEnv = DownloaderEnv (mkQHPHandle ctx (qhpEndpoint cfg)) ctx (qtisEndpoint cfg) downloaderLogAction
robotsMap <- newIORef M.empty robotsMap <- newIORef M.empty
ordersMap <- newIORef M.empty ordersMap <- newIORef M.empty
handledNotifications <- newIORef S.empty handledNotifications <- newIORef S.empty
withBroker cfg ctx robotsMap ordersMap handledNotifications $ \bro -> withBroker cfg ctx robotsMap ordersMap handledNotifications logger $ \bro ->
withQThread downloaderEnv barsMap cfg ctx $ \qt -> do withQThread downloaderEnv barsMap cfg ctx $ \qt -> do
broService <- mkBrokerService bro ordersMap
let junctionLogAction = fmtMessage >$< logTextStdout let junctionLogAction = fmtMessage >$< logTextStdout
let env = let env =
JunctionEnv JunctionEnv
@ -192,7 +200,7 @@ junctionMain descriptors = do
peLogAction = junctionLogAction peLogAction = junctionLogAction
} }
withJunction env $ do withJunction env $ do
startRobots cfg bro barsMap startRobots cfg barsMap broService
forever $ do forever $ do
saveRobots saveRobots
liftIO $ threadDelay 5000000 liftIO $ threadDelay 5000000
@ -209,7 +217,9 @@ junctionMain descriptors = do
currentTimers <- liftIO $ readIORef (strategyTimers inst) currentTimers <- liftIO $ readIORef (strategyTimers inst)
saveState currentTimers (strategyInstanceId inst <> ":timers") saveState currentTimers (strategyInstanceId inst <> ":timers")
startRobots cfg bro barsMap = forM_ (instances cfg) $ \inst -> startRobots :: ProgramConfiguration -> IORef Bars -> BrokerService -> JunctionM ()
startRobots cfg barsMap broService = forM_ (instances cfg) $ \inst -> do
now <- liftIO getCurrentTime
case M.lookup (strategyBaseName inst) descriptors of case M.lookup (strategyBaseName inst) descriptors of
Just (StrategyDescriptorE desc) -> do Just (StrategyDescriptorE desc) -> do
bigConf <- loadConfig (configKey inst) bigConf <- loadConfig (configKey inst)
@ -217,7 +227,14 @@ junctionMain descriptors = do
rState <- loadState (stateKey inst) >>= liftIO . newIORef rState <- loadState (stateKey inst) >>= liftIO . newIORef
rTimers <- loadState (stateKey inst <> ":timers") >>= liftIO . newIORef rTimers <- loadState (stateKey inst <> ":timers") >>= liftIO . newIORef
let robotLogAction = fmtMessage >$< logTextStdout let robotLogAction = fmtMessage >$< logTextStdout
let robotEnv = RobotEnv rState rConf rTimers bro barsMap robotLogAction stratEnv <- liftIO $ newIORef StrategyEnvironment
{
_seInstanceId = strategyId inst,
_seAccount = "test", -- TODO configure
_seVolume = 1,
_seLastTimestamp = now
}
let robotEnv = RobotEnv rState rConf rTimers barsMap stratEnv robotLogAction broService
robot <- createRobotDriverThread inst desc (flip runReaderT robotEnv . unRobotM) bigConf rConf rState rTimers robot <- createRobotDriverThread inst desc (flip runReaderT robotEnv . unRobotM) bigConf rConf rState rTimers
robotsMap' <- asks peRobots robotsMap' <- asks peRobots
liftIO $ atomicModifyIORef' robotsMap' (\s -> (M.insert (strategyId inst) robot s, ())) liftIO $ atomicModifyIORef' robotsMap' (\s -> (M.insert (strategyId inst) robot s, ()))
@ -229,16 +246,20 @@ junctionMain descriptors = do
handleBrokerNotification :: IORef (M.Map T.Text RobotDriverHandle) -> handleBrokerNotification :: IORef (M.Map T.Text RobotDriverHandle) ->
IORef (M.Map OrderId T.Text) -> IORef (M.Map OrderId T.Text) ->
IORef (S.Set NotificationSqnum) -> IORef (S.Set NotificationSqnum) ->
LogAction IO Message ->
Notification -> Notification ->
IO () IO ()
handleBrokerNotification robotsRef ordersMapRef handled notification = handleBrokerNotification robotsRef ordersMapRef handled logger notification= do
logWith logger Trace "Junction" $ "Incoming notification: " <> (T.pack . show) notification
whenM (notMember (getNotificationSqnum notification) <$> readIORef handled) $ do whenM (notMember (getNotificationSqnum notification) <$> readIORef handled) $ do
robotsMap <- readIORef robotsRef robotsMap <- readIORef robotsRef
ordersMap <- readIORef ordersMapRef ordersMap <- readIORef ordersMapRef
case getNotificationTarget robotsMap ordersMap notification of case getNotificationTarget robotsMap ordersMap notification of
Just robot -> postNotificationEvent robot notification Just robot -> postNotificationEvent robot notification
Nothing -> return () --logWarning "Junction" "Unknown order" -- TODO log Nothing -> do
logWith logger Warning "Junction" $ "Unknown order: " <> (T.pack . show) (notificationOrderId notification)
logWith logger Debug "Junction" $ "Ordermap: " <> (T.pack . show) (M.toList ordersMap)
atomicModifyIORef' handled (\s -> (S.insert (getNotificationSqnum notification) s, ())) atomicModifyIORef' handled (\s -> (S.insert (getNotificationSqnum notification) s, ()))
@ -250,7 +271,7 @@ junctionMain descriptors = do
notificationOrderId (OrderNotification _ oid _) = oid notificationOrderId (OrderNotification _ oid _) = oid
notificationOrderId (TradeNotification _ trade) = tradeOrderId trade notificationOrderId (TradeNotification _ trade) = tradeOrderId trade
withBroker cfg ctx robotsMap ordersMap handled f = do withBroker cfg ctx robotsMap ordersMap handled logger f = do
securityParameters <- loadBrokerSecurityParameters cfg securityParameters <- loadBrokerSecurityParameters cfg
bracket bracket
(startBrokerClient (startBrokerClient
@ -258,8 +279,9 @@ junctionMain descriptors = do
ctx ctx
(brokerEndpoint cfg) (brokerEndpoint cfg)
(brokerNotificationEndpoint cfg) (brokerNotificationEndpoint cfg)
[handleBrokerNotification robotsMap ordersMap handled] [handleBrokerNotification robotsMap ordersMap handled logger]
securityParameters) securityParameters
logger)
stopBrokerClient f stopBrokerClient f
loadBrokerSecurityParameters cfg = loadBrokerSecurityParameters cfg =

56
src/ATrade/Driver/Junction/BrokerService.hs
Unescape View File

@ -0,0 +1,56 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
module ATrade.Driver.Junction.BrokerService
(
BrokerService,
mkBrokerService,
submitOrder,
cancelOrder,
getNotifications
) where
import qualified ATrade.Broker.Client as Bro
import ATrade.Broker.Protocol (Notification (..))
import ATrade.Logging (Message, logDebug)
import ATrade.Types (Order (..), OrderId)
import Colog (WithLog)
import Control.Monad.IO.Class (MonadIO (liftIO))
import Control.Monad.Reader.Class (MonadReader)
import Data.IORef (IORef, atomicModifyIORef',
newIORef)
import qualified Data.Map.Strict as M
import qualified Data.Text as T
data BrokerService =
BrokerService
{
broker :: Bro.BrokerClientHandle,
orderMap :: IORef (M.Map OrderId T.Text),
orderIdCounter :: IORef OrderId
}
mkBrokerService :: Bro.BrokerClientHandle -> IORef (M.Map OrderId T.Text) -> IO BrokerService
mkBrokerService h om = BrokerService h om <$> newIORef 1
submitOrder :: (MonadIO m, WithLog env Message m, MonadReader env m) => BrokerService -> T.Text -> Order -> m OrderId
submitOrder service identity order = do
oid <- nextOrderId service
logDebug "BrokerService" $ "New order, id: " <> (T.pack . show) oid
liftIO $ atomicModifyIORef' (orderMap service) (\s -> (M.insert oid identity s, ()))
_ <- liftIO $ Bro.submitOrder (broker service) order { orderId = oid }
return oid
where
nextOrderId srv = liftIO $ atomicModifyIORef' (orderIdCounter srv) (\s -> (s + 1, s))
cancelOrder :: BrokerService -> OrderId -> IO ()
cancelOrder service oid = do
_ <- Bro.cancelOrder (broker service) oid
return ()
getNotifications :: BrokerService -> IO [Notification]
getNotifications service = do
v <- Bro.getNotifications (broker service)
case v of
Left _ -> return []
Right n -> return n

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

@ -15,46 +15,51 @@ module ATrade.Driver.Junction.RobotDriverThread
onStrategyInstance, onStrategyInstance,
postNotificationEvent) where postNotificationEvent) where
import ATrade.Broker.Client (BrokerClientHandle) import ATrade.Broker.Protocol (Notification (OrderNotification, TradeNotification))
import qualified ATrade.Broker.Client as Bro import qualified ATrade.Driver.Junction.BrokerService as Bro
import ATrade.Broker.Protocol (Notification (OrderNotification, TradeNotification)) import ATrade.Driver.Junction.QuoteStream (QuoteStream (addSubscription),
import ATrade.Driver.Junction.QuoteStream (QuoteStream (addSubscription), QuoteSubscription (QuoteSubscription))
QuoteSubscription (QuoteSubscription)) import ATrade.Driver.Junction.Types (BigConfig,
import ATrade.Driver.Junction.Types (BigConfig, StrategyDescriptor,
StrategyDescriptor, StrategyInstance (StrategyInstance, strategyEventCallback),
StrategyInstance (StrategyInstance, strategyEventCallback), StrategyInstanceDescriptor (configKey),
StrategyInstanceDescriptor (configKey), confStrategy,
confStrategy, confTickers, confTickers,
eventCallback, stateKey, eventCallback, stateKey,
strategyId, tickerId, strategyId, tickerId,
timeframe) timeframe)
import ATrade.Logging (Message, logInfo) import ATrade.Logging (Message, logDebug,
import ATrade.QuoteSource.Client (QuoteData (..)) logInfo, logWarning)
import ATrade.RoboCom.ConfigStorage (ConfigStorage) import ATrade.QuoteSource.Client (QuoteData (..))
import ATrade.RoboCom.Monad (Event (NewBar, NewTick, NewTrade, OrderUpdate), import ATrade.RoboCom.ConfigStorage (ConfigStorage)
MonadRobot (..)) import ATrade.RoboCom.Monad (Event (NewBar, NewTick, NewTrade, OrderSubmitted, OrderUpdate),
import ATrade.RoboCom.Persistence (MonadPersistence) MonadRobot (..),
import ATrade.RoboCom.Types (BarSeriesId (BarSeriesId), StrategyEnvironment (StrategyEnvironment, _seInstanceId, _seLastTimestamp))
Bars) import ATrade.RoboCom.Persistence (MonadPersistence)
import ATrade.Types (OrderId, OrderState, Trade) import ATrade.RoboCom.Types (BarSeriesId (BarSeriesId),
import Colog (HasLog (getLogAction, setLogAction), Bars)
LogAction) import ATrade.Types (Order (orderId), OrderId,
import Control.Concurrent (ThreadId, forkIO) OrderState, Trade)
import Control.Concurrent.BoundedChan (BoundedChan, import Colog (HasLog (getLogAction, setLogAction),
newBoundedChan, readChan, LogAction)
writeChan) import Control.Concurrent (ThreadId, forkIO)
import Control.Exception.Safe (MonadThrow) import Control.Concurrent.BoundedChan (BoundedChan,
import Control.Monad (forM_, forever, void) newBoundedChan, readChan,
import Control.Monad.IO.Class (MonadIO, liftIO) writeChan)
import Control.Monad.Reader (MonadReader, ReaderT, asks) import Control.Exception.Safe (MonadThrow)
import Data.Aeson (FromJSON, ToJSON) import Control.Monad (forM_, forever, void)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Reader (MonadReader (local),
ReaderT, asks)
import Data.Aeson (FromJSON, ToJSON)
import Data.Default import Data.Default
import Data.IORef (IORef, atomicModifyIORef', import Data.IORef (IORef,
readIORef, writeIORef) atomicModifyIORef',
import qualified Data.Map.Strict as M readIORef, writeIORef)
import qualified Data.Text.Lazy as TL import qualified Data.Map.Strict as M
import Data.Time (UTCTime) import qualified Data.Text.Lazy as TL
import Dhall (FromDhall) import Data.Time (UTCTime, getCurrentTime)
import Dhall (FromDhall)
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)
@ -94,6 +99,7 @@ createRobotDriverThread :: (MonadIO m1,
ToJSON s, ToJSON s,
FromDhall c, FromDhall c,
MonadIO m, MonadIO m,
MonadReader (RobotEnv c s) m,
MonadRobot m c s) => MonadRobot m c s) =>
StrategyInstanceDescriptor StrategyInstanceDescriptor
-> StrategyDescriptor c s -> StrategyDescriptor c s
@ -113,7 +119,7 @@ createRobotDriverThread instDesc strDesc runner bigConf rConf rState rTimers = d
forM_ (confTickers bigConf) (\x -> addSubscription (QuoteSubscription (tickerId x) (timeframe x)) quoteQueue) 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
where where
@ -127,12 +133,13 @@ onStrategyInstance (RobotDriverHandle inst _ _ _) f = f inst
data RobotEnv c s = data RobotEnv c s =
RobotEnv RobotEnv
{ {
stateRef :: IORef s, stateRef :: IORef s,
configRef :: IORef c, configRef :: IORef c,
timersRef :: IORef [UTCTime], timersRef :: IORef [UTCTime],
broker :: BrokerClientHandle, bars :: IORef Bars,
bars :: IORef Bars, env :: IORef StrategyEnvironment,
logAction :: LogAction (RobotM c s) Message logAction :: LogAction (RobotM c s) Message,
brokerService :: Bro.BrokerService
} }
newtype RobotM c s a = RobotM { unRobotM :: ReaderT (RobotEnv c s) IO a } newtype RobotM c s a = RobotM { unRobotM :: ReaderT (RobotEnv c s) IO a }
@ -144,12 +151,13 @@ instance HasLog (RobotEnv c s) Message (RobotM c s) where
instance MonadRobot (RobotM c s) c s where instance MonadRobot (RobotM c s) c s where
submitOrder order = do submitOrder order = do
bro <- asks broker instId <- _seInstanceId <$> (asks env >>= liftIO . readIORef)
liftIO $ void $ Bro.submitOrder bro order bro <- asks brokerService
Bro.submitOrder bro instId order
cancelOrder oid = do cancelOrder oid = do
bro <- asks broker bro <- asks brokerService
liftIO $ void $ Bro.cancelOrder bro oid liftIO . void $ Bro.cancelOrder bro oid
appendToLog = logInfo "RobotM" . TL.toStrict -- TODO get instance id from environment and better use it instead of generic 'RobotM' appendToLog = logInfo "RobotM" . TL.toStrict -- TODO get instance id from environment and better use it instead of generic 'RobotM'
@ -161,7 +169,11 @@ instance MonadRobot (RobotM c s) c s where
getConfig = asks configRef >>= liftIO . readIORef getConfig = asks configRef >>= liftIO . readIORef
getState = asks stateRef >>= liftIO . readIORef getState = asks stateRef >>= liftIO . readIORef
setState newState = asks stateRef >>= liftIO . flip writeIORef newState setState newState = asks stateRef >>= liftIO . flip writeIORef newState
getEnvironment = undefined getEnvironment = do
ref <- asks env
now <- liftIO getCurrentTime
liftIO $ atomicModifyIORef' ref (\e -> (e { _seLastTimestamp = now }, e { _seLastTimestamp = now}))
getTicker tid tf = do getTicker tid tf = do
b <- asks bars >>= liftIO . readIORef b <- asks bars >>= liftIO . readIORef
return $ M.lookup (BarSeriesId tid tf) b return $ M.lookup (BarSeriesId tid tf) b

2
src/ATrade/RoboCom/Monad.hs
Unescape View File

@ -34,7 +34,7 @@ import Language.Haskell.Printf
import Language.Haskell.TH.Quote (QuasiQuoter) import Language.Haskell.TH.Quote (QuasiQuoter)
class (Monad m) => MonadRobot m c s | m -> c, m -> s where class (Monad m) => MonadRobot m c s | m -> c, m -> s where
submitOrder :: Order -> m () submitOrder :: Order -> m OrderId
cancelOrder :: OrderId -> m () cancelOrder :: OrderId -> m ()
appendToLog :: TL.Text -> m () appendToLog :: TL.Text -> m ()
setupTimer :: UTCTime -> m () setupTimer :: UTCTime -> m ()

39
src/ATrade/RoboCom/Positions.hs
Unescape View File

@ -65,7 +65,8 @@ module ATrade.RoboCom.Positions
setStopLoss, setStopLoss,
setLimitStopLoss, setLimitStopLoss,
setTakeProfit, setTakeProfit,
setStopLossAndTakeProfit setStopLossAndTakeProfit,
handlePositions
) where ) where
import GHC.Generics import GHC.Generics
@ -191,9 +192,9 @@ dispatchPosition event pos = case posState pos of
if orderDeadline (posSubmissionDeadline pos) lastTs if orderDeadline (posSubmissionDeadline pos) lastTs
then return $ pos { posState = PositionCancelled } -- TODO call TimeoutHandler if present then return $ pos { posState = PositionCancelled } -- TODO call TimeoutHandler if present
else case event of else case event of
OrderSubmitted order -> OrderUpdate oid Submitted -> do
return $ if order `orderCorrespondsTo` pendingOrder return $ if orderId pendingOrder == oid
then pos { posCurrentOrder = Just order, then pos { posCurrentOrder = Just pendingOrder,
posState = PositionWaitingOpen, posState = PositionWaitingOpen,
posSubmissionDeadline = Nothing } posSubmissionDeadline = Nothing }
else pos else pos
@ -206,7 +207,6 @@ dispatchPosition event pos = case posState pos of
then then
if posBalance pos == 0 if posBalance pos == 0
then do then do
appendToLog $ [t|"In PositionWaitingOpen: execution timeout: %?/%?"|] (posExecutionDeadline pos) lastTs
cancelOrder $ orderId order cancelOrder $ orderId order
return $ pos { posState = PositionWaitingPendingCancellation, posNextState = Just PositionCancelled } return $ pos { posState = PositionWaitingPendingCancellation, posNextState = Just PositionCancelled }
else do else do
@ -271,8 +271,11 @@ dispatchPosition event pos = case posState pos of
(OrderUpdate _ newstate, Just _, Just (PositionWaitingCloseSubmission nextOrder)) -> (OrderUpdate _ newstate, Just _, Just (PositionWaitingCloseSubmission nextOrder)) ->
if newstate == Cancelled if newstate == Cancelled
then do then do
submitOrder nextOrder oid <- submitOrder nextOrder
return pos { posState = PositionWaitingCloseSubmission nextOrder, posSubmissionDeadline = Just (10 `addUTCTime` lastTs), posExecutionDeadline = Nothing } return pos
{ posState = PositionWaitingCloseSubmission nextOrder { orderId = oid },
posSubmissionDeadline = Just (10 `addUTCTime` lastTs),
posExecutionDeadline = Nothing }
else return pos else return pos
(OrderUpdate _ newstate, Just _, Just PositionCancelled) -> (OrderUpdate _ newstate, Just _, Just PositionCancelled) ->
if newstate == Cancelled if newstate == Cancelled
@ -292,9 +295,9 @@ dispatchPosition event pos = case posState pos of
Nothing -> doNothing Nothing -> doNothing
return $ pos { posCurrentOrder = Nothing, posState = PositionOpen, posSubmissionDeadline = Nothing } -- TODO call TimeoutHandler if present return $ pos { posCurrentOrder = Nothing, posState = PositionOpen, posSubmissionDeadline = Nothing } -- TODO call TimeoutHandler if present
else case event of else case event of
OrderSubmitted order -> OrderUpdate oid Submitted ->
return $ if order `orderCorrespondsTo` pendingOrder return $ if orderId pendingOrder == oid
then pos { posCurrentOrder = Just order, then pos { posCurrentOrder = Just pendingOrder,
posState = PositionWaitingClose, posState = PositionWaitingClose,
posSubmissionDeadline = Nothing } posSubmissionDeadline = Nothing }
else pos else pos
@ -464,8 +467,8 @@ enterAtMarket operationSignalName operation = do
enterAtMarketWithParams :: (StateHasPositions s, ParamsHasMainTicker c, MonadRobot m c s) => T.Text -> Int -> SignalId -> Operation -> m Position enterAtMarketWithParams :: (StateHasPositions s, ParamsHasMainTicker c, MonadRobot m c s) => T.Text -> Int -> SignalId -> Operation -> m Position
enterAtMarketWithParams account quantity signalId operation = do enterAtMarketWithParams account quantity signalId operation = do
tickerId <- snd . mainTicker <$> getConfig tickerId <- snd . mainTicker <$> getConfig
submitOrder $ order tickerId oid <- submitOrder $ order tickerId
newPosition (order tickerId) account tickerId operation quantity 20 newPosition ((order tickerId) { orderId = oid }) account tickerId operation quantity 20
where where
order tickerId = mkOrder { order tickerId = mkOrder {
orderAccountId = account, orderAccountId = account,
@ -508,9 +511,9 @@ enterAtLimitForTicker tickerId timeToCancel operationSignalName price operation
enterAtLimitForTickerWithParams :: (StateHasPositions s, MonadRobot m c s) => TickerId -> NominalDiffTime -> T.Text -> Int -> SignalId -> Price -> Operation -> m Position enterAtLimitForTickerWithParams :: (StateHasPositions s, MonadRobot m c s) => TickerId -> NominalDiffTime -> T.Text -> Int -> SignalId -> Price -> Operation -> m Position
enterAtLimitForTickerWithParams tickerId timeToCancel account quantity signalId price operation = do enterAtLimitForTickerWithParams tickerId timeToCancel account quantity signalId price operation = do
lastTs <- view seLastTimestamp <$> getEnvironment lastTs <- view seLastTimestamp <$> getEnvironment
submitOrder order oid <- submitOrder order
appendToLog $ [t|enterAtLimit: %?, deadline: %?|] tickerId (timeToCancel `addUTCTime` lastTs) appendToLog $ [t|enterAtLimit: %?, deadline: %?|] tickerId (timeToCancel `addUTCTime` lastTs)
newPosition order account tickerId operation quantity 20 >>= newPosition (order {orderId = oid}) account tickerId operation quantity 20 >>=
modifyPosition (\p -> p { posExecutionDeadline = Just $ timeToCancel `addUTCTime` lastTs }) modifyPosition (\p -> p { posExecutionDeadline = Just $ timeToCancel `addUTCTime` lastTs })
where where
order = mkOrder { order = mkOrder {
@ -554,10 +557,10 @@ exitAtMarket position operationSignalName = do
posExecutionDeadline = Nothing }) position posExecutionDeadline = Nothing }) position
Nothing -> do Nothing -> do
submitOrder (closeOrder inst) oid <- submitOrder (closeOrder inst)
modifyPosition (\pos -> modifyPosition (\pos ->
pos { posCurrentOrder = Nothing, pos { posCurrentOrder = Nothing,
posState = PositionWaitingCloseSubmission (closeOrder inst), posState = PositionWaitingCloseSubmission (closeOrder inst) { orderId = oid },
posNextState = Just PositionClosed, posNextState = Just PositionClosed,
posSubmissionDeadline = Just $ 10 `addUTCTime` lastTs, posSubmissionDeadline = Just $ 10 `addUTCTime` lastTs,
posExecutionDeadline = Nothing }) position posExecutionDeadline = Nothing }) position
@ -578,11 +581,11 @@ exitAtLimit timeToCancel price position operationSignalName = do
case posCurrentOrder position of case posCurrentOrder position of
Just order -> cancelOrder (orderId order) Just order -> cancelOrder (orderId order)
Nothing -> doNothing Nothing -> doNothing
submitOrder (closeOrder inst) oid <- submitOrder (closeOrder inst)
appendToLog $ [t|exitAtLimit: %?, deadline: %?|] (posTicker position) (timeToCancel `addUTCTime` lastTs) appendToLog $ [t|exitAtLimit: %?, deadline: %?|] (posTicker position) (timeToCancel `addUTCTime` lastTs)
modifyPosition (\pos -> modifyPosition (\pos ->
pos { posCurrentOrder = Nothing, pos { posCurrentOrder = Nothing,
posState = PositionWaitingCloseSubmission (closeOrder inst), posState = PositionWaitingCloseSubmission (closeOrder inst) { orderId = oid },
posNextState = Just PositionClosed, posNextState = Just PositionClosed,
posSubmissionDeadline = Just $ 10 `addUTCTime` lastTs, posSubmissionDeadline = Just $ 10 `addUTCTime` lastTs,
posExecutionDeadline = Just $ timeToCancel `addUTCTime` lastTs }) position posExecutionDeadline = Just $ timeToCancel `addUTCTime` lastTs }) position

Write Preview
Loading…
Cancel
Save