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

Refactoring: removed Strategy record

stable
Denis Tereshkin 5 years ago
parent
9d5cb7f076
commit
23f5e0ab8c
4 changed files with 111 additions and 134 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. 141
      src/ATrade/Driver/Real.hs
  2. 6
      src/ATrade/Driver/Real/QuoteSourceThread.hs
  3. 12
      src/ATrade/Driver/Types.hs
  4. 4
      src/ATrade/RoboCom/Utils.hs

141
src/ATrade/Driver/Real.hs
Unescape View File

@ -1,60 +1,67 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
module ATrade.Driver.Real ( module ATrade.Driver.Real (
Strategy(..),
StrategyInstanceParams(..), StrategyInstanceParams(..),
robotMain, robotMain,
BigConfig(..), BigConfig(..),
mkBarStrategy,
barStrategyDriver barStrategyDriver
) where ) where
import Options.Applicative import ATrade.BarAggregator
import System.IO import ATrade.Driver.Real.BrokerClientThread
import System.Signal import ATrade.Driver.Real.QuoteSourceThread
import System.Exit import ATrade.Driver.Types (InitializationCallback, StrategyInstanceParams (..))
import System.Random import ATrade.Exceptions
import System.Log.Logger import ATrade.Quotes
import System.Log.Handler.Simple import ATrade.Quotes.QHP as QQ
import System.Log.Handler (setFormatter) import ATrade.RoboCom.Monad (Event (..),
import System.Log.Formatter EventCallback,
import Control.Monad MonadRobot (..),
import Control.Monad.Reader StrategyEnvironment (..),
import Control.Concurrent hiding (writeChan, readChan, writeList2Chan, yield) seBars, seLastTimestamp)
import ATrade.RoboCom.Types (BarSeries (..),
Ticker (..),
Timeframe (..))
import ATrade.RoboCom.Utils (fromHMS)
import ATrade.Types
import Control.Concurrent hiding (readChan,
writeChan,
writeList2Chan, yield)
import Control.Concurrent.BoundedChan as BC import Control.Concurrent.BoundedChan as BC
import Control.Exception.Safe import Control.Exception.Safe
import Control.Lens hiding (Context, (.=)) import Control.Lens hiding (Context, (.=))
import Control.Monad
import Control.Monad.Reader
import Data.Aeson
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy as BL
import Data.IORef
import qualified Data.Map as M import qualified Data.Map as M
import Data.Maybe
import qualified Data.Text as T import qualified Data.Text as T
import Data.Text.Encoding import Data.Text.Encoding
import Data.Aeson
import Data.IORef
import Data.Time.Calendar import Data.Time.Calendar
import Data.Time.Clock import Data.Time.Clock
import Data.Time.Clock.POSIX import Data.Time.Clock.POSIX
import Data.Maybe import Database.Redis hiding (decode, info)
import Database.Redis hiding (info, decode)
import ATrade.Types
import ATrade.Quotes
import ATrade.RoboCom.Monad (EventCallback, Event(..), StrategyEnvironment(..), seBars, seLastTimestamp, Event(..), MonadRobot(..))
import ATrade.BarAggregator
import ATrade.Driver.Real.BrokerClientThread
import ATrade.Driver.Real.QuoteSourceThread
import ATrade.Driver.Types (Strategy(..), StrategyInstanceParams(..), InitializationCallback)
import ATrade.RoboCom.Types (BarSeries(..), Ticker(..), Timeframe(..))
import ATrade.Exceptions
import ATrade.Quotes.QHP as QQ
import System.ZMQ4 hiding (Event(..))
import GHC.Generics import GHC.Generics
import Options.Applicative
import System.Exit
import System.IO
import System.Log.Formatter
import System.Log.Handler (setFormatter)
import System.Log.Handler.Simple
import System.Log.Logger
import System.Random
import System.Signal
import System.ZMQ4 hiding (Event (..))
data Params = Params { data Params = Params {
instanceId :: String, instanceId :: String,
@ -187,7 +194,7 @@ storeState params stateRef timersRef = do
Nothing -> withFile (strategyStateFile params) WriteMode (\f -> BS.hPut f $ BL.toStrict $ encode currentStrategyState) Nothing -> withFile (strategyStateFile params) WriteMode (\f -> BS.hPut f $ BL.toStrict $ encode currentStrategyState)
`catch` (\e -> warningM "main" ("Unable to save state: " ++ show (e :: IOException))) `catch` (\e -> warningM "main" ("Unable to save state: " ++ show (e :: IOException)))
Just sock -> do Just sock -> do
#ifdef linux_HOST_OS
conn <- checkedConnect $ defaultConnectInfo { connectPort = UnixSocket sock } conn <- checkedConnect $ defaultConnectInfo { connectPort = UnixSocket sock }
now <- getPOSIXTime now <- getPOSIXTime
res <- runRedis conn $ mset [(encodeUtf8 $ T.pack $ instanceId params, BL.toStrict $ encode currentStrategyState), res <- runRedis conn $ mset [(encodeUtf8 $ T.pack $ instanceId params, BL.toStrict $ encode currentStrategyState),
@ -197,9 +204,9 @@ storeState params stateRef timersRef = do
case res of case res of
Left _ -> warningM "main" "Unable to save state" Left _ -> warningM "main" "Unable to save state"
Right _ -> return () Right _ -> return ()
#else
return ()
#endif
gracefulShutdown :: (ToJSON s) => Params -> IORef s -> IORef [UTCTime] -> MVar () -> Signal -> IO () gracefulShutdown :: (ToJSON s) => Params -> IORef s -> IORef [UTCTime] -> MVar () -> Signal -> IO ()
gracefulShutdown params stateRef timersRef shutdownMv _ = do gracefulShutdown params stateRef timersRef shutdownMv _ = do
@ -229,24 +236,21 @@ robotMain dataDownloadDelta defaultState initCallback callback = do
Just cb -> cb config instanceParams Just cb -> cb config instanceParams
Nothing -> return config Nothing -> return config
let strategy = mkBarStrategy instanceParams dataDownloadDelta updatedConfig stratState callback
stateRef <- newIORef stratState stateRef <- newIORef stratState
configRef <- newIORef updatedConfig configRef <- newIORef updatedConfig
timersRef <- newIORef timersState timersRef <- newIORef timersState
shutdownMv <- newEmptyMVar shutdownMv <- newEmptyMVar
installHandler sigINT (gracefulShutdown params stateRef timersRef shutdownMv) installHandler sigINT (gracefulShutdown params stateRef timersRef shutdownMv)
installHandler sigTERM (gracefulShutdown params stateRef timersRef shutdownMv) installHandler sigTERM (gracefulShutdown params stateRef timersRef shutdownMv)
randsec <- getStdRandom(randomR(1, 10))
threadDelay $ randsec * 1000000
debugM "main" "Forking state saving thread" debugM "main" "Forking state saving thread"
stateSavingThread <- forkIO $ forever $ do stateSavingThread <- forkIO $ forever $ do
threadDelay 1000000 threadDelay 1000000
storeState params stateRef timersRef storeState params stateRef timersRef
straEnv <- newIORef StrategyEnvironment { straEnv <- newIORef StrategyEnvironment {
_seInstanceId = strategyInstanceId . strategyInstanceParams $ strategy, _seInstanceId = strategyInstanceId instanceParams,
_seAccount = strategyAccount . strategyInstanceParams $ strategy, _seAccount = strategyAccount instanceParams,
_seVolume = strategyVolume . strategyInstanceParams $ strategy, _seVolume = strategyVolume instanceParams,
_seBars = M.empty, _seBars = M.empty,
_seLastTimestamp = UTCTime (fromGregorian 1970 1 1) 0 _seLastTimestamp = UTCTime (fromGregorian 1970 1 1) 0
} }
@ -261,9 +265,9 @@ robotMain dataDownloadDelta defaultState initCallback callback = do
let qsEp = T.pack $ quotesourceEp params let qsEp = T.pack $ quotesourceEp params
let brEp = T.pack $ brokerEp params let brEp = T.pack $ brokerEp params
agg <- newIORef $ mkAggregatorFromBars M.empty [(hmsToDiffTime 3 50 0, hmsToDiffTime 21 10 0)] agg <- newIORef $ mkAggregatorFromBars M.empty [(hmsToDiffTime 3 50 0, hmsToDiffTime 21 10 0)]
bracket (startQuoteSourceThread ctx qsEp strategy eventChan agg tickFilter (sourceBarTimeframe params)) killThread $ \_ -> do bracket (startQuoteSourceThread ctx qsEp instanceParams eventChan agg tickFilter (sourceBarTimeframe params)) killThread $ \_ -> do
debugM "Strategy" "QuoteSource thread forked" debugM "Strategy" "QuoteSource thread forked"
bracket (startBrokerClientThread (strategyInstanceId . strategyInstanceParams $ strategy) ctx brEp brokerChan eventChan shutdownMv) killThread $ \_ -> do bracket (startBrokerClientThread (strategyInstanceId instanceParams) ctx brEp brokerChan eventChan shutdownMv) killThread $ \_ -> do
debugM "Strategy" "Broker thread forked" debugM "Strategy" "Broker thread forked"
now <- getCurrentTime >>= newIORef now <- getCurrentTime >>= newIORef
@ -280,7 +284,7 @@ robotMain dataDownloadDelta defaultState initCallback callback = do
envAggregator = agg, envAggregator = agg,
envLastTimestamp = now envLastTimestamp = now
} }
runReaderT (barStrategyDriver strategy shutdownMv) env `finally` killThread stateSavingThread) runReaderT (barStrategyDriver dataDownloadDelta instanceParams callback shutdownMv) env `finally` killThread stateSavingThread)
where where
tickFilter :: Tick -> Bool tickFilter :: Tick -> Bool
tickFilter tick = tickFilter tick =
@ -292,7 +296,6 @@ robotMain dataDownloadDelta defaultState initCallback callback = do
fortsIntervals = [(fromHMS 4 0 0, fromHMS 11 0 0), (fromHMS 11 5 0, fromHMS 15 45 0), (fromHMS 16 0 0, fromHMS 20 50 0)] fortsIntervals = [(fromHMS 4 0 0, fromHMS 11 0 0), (fromHMS 11 5 0, fromHMS 15 45 0), (fromHMS 16 0 0, fromHMS 20 50 0)]
secIntervals = [(fromHMS 6 50 0, fromHMS 15 51 0)] secIntervals = [(fromHMS 6 50 0, fromHMS 15 51 0)]
fromHMS h m s = h * 3600 + m * 60 + s
inInterval ts (start, end) = ts >= start && ts <= end inInterval ts (start, end) = ts >= start && ts <= end
opts = info (helper <*> paramsParser) opts = info (helper <*> paramsParser)
@ -318,7 +321,7 @@ robotMain dataDownloadDelta defaultState initCallback callback = do
loadStrategyTimers params = case redisSocket params of loadStrategyTimers params = case redisSocket params of
Nothing -> return [] Nothing -> return []
Just sock -> do Just sock -> do
#ifdef linux_HOST_OS
conn <- checkedConnect $ defaultConnectInfo { connectPort = UnixSocket sock } conn <- checkedConnect $ defaultConnectInfo { connectPort = UnixSocket sock }
res <- runRedis conn $ get (encodeUtf8 $ T.pack $ instanceId params ++ ":timers") res <- runRedis conn $ get (encodeUtf8 $ T.pack $ instanceId params ++ ":timers")
case res of case res of
@ -334,15 +337,11 @@ robotMain dataDownloadDelta defaultState initCallback callback = do
Nothing -> do Nothing -> do
warningM "main" "Unable to load state" warningM "main" "Unable to load state"
return [] return []
#else
error "Not implemented"
#endif
loadStrategyState params = case redisSocket params of loadStrategyState params = case redisSocket params of
Nothing -> loadStateFromFile (strategyStateFile params) Nothing -> loadStateFromFile (strategyStateFile params)
Just sock -> do Just sock -> do
#ifdef linux_HOST_OS
conn <- checkedConnect $ defaultConnectInfo { connectPort = UnixSocket sock } conn <- checkedConnect $ defaultConnectInfo { connectPort = UnixSocket sock }
res <- runRedis conn $ get (encodeUtf8 $ T.pack $ instanceId params) res <- runRedis conn $ get (encodeUtf8 $ T.pack $ instanceId params)
case res of case res of
@ -358,9 +357,6 @@ robotMain dataDownloadDelta defaultState initCallback callback = do
Nothing -> do Nothing -> do
warningM "main" "Unable to load state" warningM "main" "Unable to load state"
return defaultState return defaultState
#else
error "Not implemented"
#endif
loadStateFromFile filepath = withFile filepath ReadMode (\f -> do loadStateFromFile filepath = withFile filepath ReadMode (\f -> do
maybeState <- decode . BL.fromStrict <$> BS.hGetContents f maybeState <- decode . BL.fromStrict <$> BS.hGetContents f
@ -369,23 +365,12 @@ robotMain dataDownloadDelta defaultState initCallback callback = do
Nothing -> return defaultState ) `catch` Nothing -> return defaultState ) `catch`
(\e -> warningM "main" ("Unable to load state: " ++ show (e :: IOException)) >> return defaultState) (\e -> warningM "main" ("Unable to load state: " ++ show (e :: IOException)) >> return defaultState)
-- | Helper function to make 'Strategy' instances
mkBarStrategy :: StrategyInstanceParams -> DiffTime -> c -> s -> EventCallback c s -> Strategy c s
mkBarStrategy instanceParams dd params initialState cb = BarStrategy {
downloadDelta = dd,
eventCallback = cb,
currentState = initialState,
strategyParams = params,
strategyTimers = [],
strategyInstanceParams = instanceParams }
-- | Main function which handles incoming events (ticks/orders), passes them to strategy callback -- | Main function which handles incoming events (ticks/orders), passes them to strategy callback
-- and executes returned strategy actions -- and executes returned strategy actions
barStrategyDriver :: (MonadHistory (App hs c s)) => Strategy c s -> MVar () -> App hs c s () barStrategyDriver :: (MonadHistory (App hs c s)) => DiffTime -> StrategyInstanceParams -> EventCallback c s -> MVar () -> App hs c s ()
barStrategyDriver strategy shutdownVar = do barStrategyDriver downloadDelta instanceParams callback shutdownVar = do
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
history <- M.fromList <$> mapM (loadTickerHistory now) (tickers . strategyInstanceParams $ strategy) history <- M.fromList <$> mapM (loadTickerHistory now) (tickers instanceParams)
eventChan <- asks envEventChan eventChan <- asks envEventChan
brokerChan <- asks envBrokerChan brokerChan <- asks envBrokerChan
agg <- asks envAggregator agg <- asks envAggregator
@ -400,18 +385,17 @@ barStrategyDriver strategy shutdownVar = do
writeChan brokerChan BrokerRequestNotifications writeChan brokerChan BrokerRequestNotifications
lift $ debugM "Strategy" "Wakeup thread forked" lift $ debugM "Strategy" "Wakeup thread forked"
readAndHandleEvents agg strategy readAndHandleEvents agg instanceParams
lift $ debugM "Strategy" "Stopping strategy driver" lift $ debugM "Strategy" "Stopping strategy driver"
lift $ killThread wakeupTid lift $ killThread wakeupTid
where where
loadTickerHistory now t = do loadTickerHistory now t = do
history <- getHistory (code t) (BarTimeframe (fromInteger . timeframeSeconds $ t)) history <- getHistory (code t) (BarTimeframe (fromInteger . timeframeSeconds $ t))
((fromRational . toRational . negate $ downloadDelta strategy) `addUTCTime` now) now ((fromRational . toRational . negate $ downloadDelta) `addUTCTime` now) now
return (code t, BarSeries (code t) (Timeframe (timeframeSeconds t)) history) return (code t, BarSeries (code t) (Timeframe (timeframeSeconds t)) history)
readAndHandleEvents agg strategy' = do readAndHandleEvents agg instanceParams' = do
eventChan <- asks envEventChan eventChan <- asks envEventChan
event <- lift $ readChan eventChan event <- lift $ readChan eventChan
if event /= Shutdown if event /= Shutdown
@ -423,12 +407,13 @@ barStrategyDriver strategy shutdownVar = do
nowRef <- asks envLastTimestamp nowRef <- asks envLastTimestamp
lift $ writeIORef nowRef newTimestamp lift $ writeIORef nowRef newTimestamp
newTimers <- catMaybes <$> (mapM (checkTimer eventChan newTimestamp) $ strategyTimers strategy')
(eventCallback strategy) event
timersRef <- asks envTimers timersRef <- asks envTimers
oldTimers <- lift $ readIORef timersRef
newTimers <- catMaybes <$> mapM (checkTimer eventChan newTimestamp) oldTimers
callback event
lift $ writeIORef timersRef newTimers lift $ writeIORef timersRef newTimers
readAndHandleEvents agg strategy' readAndHandleEvents agg instanceParams'
else else
lift $ debugM "Strategy" "Shutdown requested" lift $ debugM "Strategy" "Shutdown requested"
where where

6
src/ATrade/Driver/Real/QuoteSourceThread.hs
Unescape View File

@ -24,8 +24,8 @@ import Control.Monad
import System.Log.Logger import System.Log.Logger
import System.ZMQ4 hiding (Event) import System.ZMQ4 hiding (Event)
startQuoteSourceThread :: Context -> T.Text -> Strategy c s -> BoundedChan Event -> IORef BarAggregator -> (Tick -> Bool) -> Maybe Int -> IO ThreadId startQuoteSourceThread :: Context -> T.Text -> StrategyInstanceParams -> BoundedChan Event -> IORef BarAggregator -> (Tick -> Bool) -> Maybe Int -> IO ThreadId
startQuoteSourceThread ctx qsEp strategy eventChan agg tickFilter maybeSourceTimeframe = forkIO $ do startQuoteSourceThread ctx qsEp instanceParams eventChan agg tickFilter maybeSourceTimeframe = forkIO $ do
tickChan <- newBoundedChan 1000 tickChan <- newBoundedChan 1000
bracket (startQuoteSourceClient tickChan tickersList ctx qsEp defaultClientSecurityParams) bracket (startQuoteSourceClient tickChan tickersList ctx qsEp defaultClientSecurityParams)
(\qs -> do (\qs -> do
@ -56,5 +56,5 @@ startQuoteSourceThread ctx qsEp strategy eventChan agg tickFilter maybeSourceTim
goodTick tick = tickFilter tick && goodTick tick = tickFilter tick &&
(datatype tick /= LastTradePrice || (datatype tick == LastTradePrice && volume tick > 0)) (datatype tick /= LastTradePrice || (datatype tick == LastTradePrice && volume tick > 0))
tickersList = fmap code . (tickers . strategyInstanceParams) $ strategy tickersList = fmap code . tickers $ instanceParams

12
src/ATrade/Driver/Types.hs
Unescape View File

@ -2,7 +2,6 @@
module ATrade.Driver.Types module ATrade.Driver.Types
( (
Strategy(..),
StrategyInstanceParams(..), StrategyInstanceParams(..),
InitializationCallback InitializationCallback
) where ) where
@ -13,17 +12,6 @@ import ATrade.RoboCom.Types
import qualified Data.Text as T import qualified Data.Text as T
import Data.Time.Clock import Data.Time.Clock
-- | Top-level strategy configuration and state
data Strategy c s = BarStrategy {
downloadDelta :: DiffTime, -- ^ How much history to download at strategy start
eventCallback :: EventCallback c s, -- ^ Strategy event callback
currentState :: s, -- ^ Current strategy state. Updated after each 'EventCallback' call
strategyParams :: c, -- ^ Strategy params
strategyTimers :: [UTCTime],
strategyInstanceParams :: StrategyInstanceParams -- ^ Instance params
}
-- | Strategy instance params store few params which are common for all strategies -- | Strategy instance params store few params which are common for all strategies
data StrategyInstanceParams = StrategyInstanceParams { data StrategyInstanceParams = StrategyInstanceParams {
strategyInstanceId :: T.Text, -- ^ Strategy instance identifier. Should be unique among all strategies (very desirable) strategyInstanceId :: T.Text, -- ^ Strategy instance identifier. Should be unique among all strategies (very desirable)

4
src/ATrade/RoboCom/Utils.hs
Unescape View File

@ -9,6 +9,7 @@ module ATrade.RoboCom.Utils (
barNumber, barNumber,
getHMS, getHMS,
getHMS', getHMS',
fromHMS,
fromHMS', fromHMS',
parseTime parseTime
) where ) where
@ -66,6 +67,9 @@ fromHMS' hms = fromIntegral $ h * 3600 + m * 60 + s
m = (hms `mod` 10000) `div` 100 m = (hms `mod` 10000) `div` 100
s = (hms `mod` 100) s = (hms `mod` 100)
fromHMS :: Int -> Int -> Int -> DiffTime
fromHMS h m s = fromIntegral $ h * 3600 + m * 60 + s
parseTime :: T.Text -> Maybe DiffTime parseTime :: T.Text -> Maybe DiffTime
parseTime x = case readMaybe (T.unpack x) of parseTime x = case readMaybe (T.unpack x) of
Just t -> let h = t `div` 10000 Just t -> let h = t `div` 10000

Write Preview
Loading…
Cancel
Save