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

Refactoring: make QTIS requests in driver

stable
Denis Tereshkin 5 years ago
parent
e4c4699c69
commit
9c5cce031f
6 changed files with 93 additions and 55 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. 38
      src/ATrade/Driver/Backtest.hs
  2. 48
      src/ATrade/Driver/Real.hs
  3. 1
      src/ATrade/Exceptions.hs
  4. 10
      src/ATrade/Quotes.hs
  5. 39
      src/ATrade/Quotes/QTIS.hs
  6. 12
      src/ATrade/RoboCom/Types.hs

38
src/ATrade/Driver/Backtest.hs
Unescape View File

@ -16,14 +16,16 @@ module ATrade.Driver.Backtest (
import ATrade.Driver.Types (InitializationCallback, import ATrade.Driver.Types (InitializationCallback,
StrategyInstanceParams (..)) StrategyInstanceParams (..))
import ATrade.Exceptions import ATrade.Exceptions
import ATrade.Quotes
import ATrade.Quotes.Finam as QF import ATrade.Quotes.Finam as QF
import ATrade.Quotes.QTIS
import ATrade.RoboCom.Monad (Event (..), EventCallback, import ATrade.RoboCom.Monad (Event (..), EventCallback,
MonadRobot (..), MonadRobot (..),
StrategyEnvironment (..), StrategyEnvironment (..),
appendToLog, seBars, seLastTimestamp) appendToLog, seBars, seLastTimestamp)
import ATrade.RoboCom.Positions import ATrade.RoboCom.Positions
import ATrade.RoboCom.Types (BarSeries (..), Ticker (..), import ATrade.RoboCom.Types (BarSeries (..), Bars, InstrumentParameters (InstrumentParameters),
Timeframe (..)) Ticker (..), Timeframe (..))
import ATrade.Types import ATrade.Types
import Conduit (awaitForever, runConduit, yield, import Conduit (awaitForever, runConduit, yield,
(.|)) (.|))
@ -52,13 +54,14 @@ import qualified Data.Vector as V
import Options.Applicative hiding (Success) import Options.Applicative hiding (Success)
import Prelude hiding (lookup, putStrLn, readFile) import Prelude hiding (lookup, putStrLn, readFile)
import Safe (headMay) import Safe (headMay)
import System.ZMQ4 hiding (Event)
data Feed = Feed TickerId FilePath data Feed = Feed TickerId FilePath
deriving (Show, Eq) deriving (Show, Eq)
data Params = Params { data Params = Params {
strategyConfigFile :: FilePath, strategyConfigFile :: FilePath,
qtisEndpoint :: Maybe String, qtisEndpoint :: String,
paramsFeeds :: [Feed] paramsFeeds :: [Feed]
} deriving (Show, Eq) } deriving (Show, Eq)
@ -82,8 +85,8 @@ paramsParser = Params
<$> strOption ( <$> strOption (
long "config" <> short 'c' long "config" <> short 'c'
) )
<*> optional ( strOption <*> strOption
( long "qtis" <> short 'q' <> metavar "ENDPOINT/ID" )) ( long "qtis" <> short 'q' <> metavar "ENDPOINT/ID" )
<*> some (option feedArgParser ( <*> some (option feedArgParser (
long "feed" <> short 'f' long "feed" <> short 'f'
)) ))
@ -103,7 +106,7 @@ backtestMain _dataDownloadDelta defaultState initCallback callback = do
strategyAccount = "foo", strategyAccount = "foo",
strategyVolume = 1, strategyVolume = 1,
tickers = tickerList, tickers = tickerList,
strategyQTISEp = T.pack <$> qtisEndpoint params} strategyQTISEp = Nothing }
updatedConfig <- case initCallback of updatedConfig <- case initCallback of
Just cb -> cb config instanceParams Just cb -> cb config instanceParams
@ -111,11 +114,24 @@ backtestMain _dataDownloadDelta defaultState initCallback callback = do
feeds <- loadFeeds (paramsFeeds params) feeds <- loadFeeds (paramsFeeds params)
runBacktestDriver feeds updatedConfig tickerList bars <- makeBars (T.pack $ qtisEndpoint params) tickerList
runBacktestDriver feeds updatedConfig bars
where where
opts = info (helper <*> paramsParser) opts = info (helper <*> paramsParser)
( fullDesc <> header "ATrade strategy backtesting framework" ) ( fullDesc <> header "ATrade strategy backtesting framework" )
makeBars :: T.Text -> [Ticker] -> IO (M.Map TickerId BarSeries)
makeBars qtisEp tickersList =
withContext $ \ctx ->
M.fromList <$> mapM (mkBarEntry ctx qtisEp) tickersList
mkBarEntry ctx qtisEp tickerEntry = do
info <- qtisGetTickersInfo ctx qtisEp (code tickerEntry)
return (code tickerEntry, BarSeries (code tickerEntry) (Timeframe (timeframeSeconds tickerEntry)) [] (InstrumentParameters (fromInteger $ tiLotSize info) (tiTickSize info)))
runBacktestDriver feeds params tickerList = do runBacktestDriver feeds params tickerList = do
let s = runConduit $ barStreamFromFeeds feeds .| backtestLoop let s = runConduit $ barStreamFromFeeds feeds .| backtestLoop
let finalState = execState (unBacktestingMonad s) $ defaultBacktestState defaultState params tickerList let finalState = execState (unBacktestingMonad s) $ defaultBacktestState defaultState params tickerList
@ -286,12 +302,10 @@ backtestMain _dataDownloadDelta defaultState initCallback callback = do
instance (Default c, Default s) => Default (BacktestState c s) instance (Default c, Default s) => Default (BacktestState c s)
where where
def = defaultBacktestState def def [] def = defaultBacktestState def def def
defaultBacktestState :: s -> c -> [Ticker] -> BacktestState c s defaultBacktestState :: s -> c -> Bars -> BacktestState c s
defaultBacktestState s c tickerList = BacktestState 0 s c (StrategyEnvironment "" "" 1 tickers' (UTCTime (fromGregorian 1970 1 1) 0)) [] Seq.empty [] 1 [] [] defaultBacktestState s c bars = BacktestState 0 s c (StrategyEnvironment "" "" 1 bars (UTCTime (fromGregorian 1970 1 1) 0)) [] Seq.empty [] 1 [] []
where
tickers' = M.fromList $ map (\x -> (code x, BarSeries (code x) (Timeframe (timeframeSeconds x)) [])) tickerList
newtype BacktestingMonad s c a = BacktestingMonad { unBacktestingMonad :: State (BacktestState s c) a } newtype BacktestingMonad s c a = BacktestingMonad { unBacktestingMonad :: State (BacktestState s c) a }
deriving (Functor, Applicative, Monad, MonadState (BacktestState s c)) deriving (Functor, Applicative, Monad, MonadState (BacktestState s c))

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

@ -19,14 +19,16 @@ import ATrade.Driver.Real.BrokerClientThread
import ATrade.Driver.Real.QuoteSourceThread import ATrade.Driver.Real.QuoteSourceThread
import ATrade.Driver.Types (InitializationCallback, StrategyInstanceParams (..)) import ATrade.Driver.Types (InitializationCallback, StrategyInstanceParams (..))
import ATrade.Exceptions import ATrade.Exceptions
import ATrade.Quotes import ATrade.Quotes (MonadHistory (..), MonadInstrumentParametersSource (..))
import ATrade.Quotes.QHP as QQ import ATrade.Quotes.QHP as QQ
import ATrade.Quotes.QTIS (TickerInfo (..),
qtisGetTickersInfo)
import ATrade.RoboCom.Monad (Event (..), import ATrade.RoboCom.Monad (Event (..),
EventCallback, EventCallback,
MonadRobot (..), MonadRobot (..),
StrategyEnvironment (..), StrategyEnvironment (..),
seBars, seLastTimestamp) seBars, seLastTimestamp)
import ATrade.RoboCom.Types (BarSeries (..), import ATrade.RoboCom.Types (BarSeries (..), InstrumentParameters (..),
Ticker (..), Ticker (..),
Timeframe (..)) Timeframe (..))
import ATrade.RoboCom.Utils (fromHMS) import ATrade.RoboCom.Utils (fromHMS)
@ -72,7 +74,7 @@ data Params = Params {
historyProviderType :: Maybe String, historyProviderType :: Maybe String,
historyProvider :: Maybe String, historyProvider :: Maybe String,
redisSocket :: Maybe String, redisSocket :: Maybe String,
qtisSocket :: Maybe String, qtisEndpoint :: String,
accountId :: String, accountId :: String,
volumeFactor :: Int, volumeFactor :: Int,
sourceBarTimeframe :: Maybe Int sourceBarTimeframe :: Maybe Int
@ -104,9 +106,9 @@ paramsParser = Params
<*> optional ( strOption <*> optional ( strOption
( long "redis-socket" ( long "redis-socket"
<> metavar "ADDRESS" )) <> metavar "ADDRESS" ))
<*> optional ( strOption <*> strOption
( long "qtis" ( long "qtis"
<> metavar "ENDPOINT/ID" )) <> metavar "ENDPOINT/ID" )
<*> strOption <*> strOption
( long "account" ( long "account"
<> metavar "ACCOUNT" ) <> metavar "ACCOUNT" )
@ -118,7 +120,9 @@ paramsParser = Params
<> metavar "SECONDS" )) <> metavar "SECONDS" ))
data Env historySource c s = Env { data Env historySource c s = Env {
envZeromqContext :: Context,
envHistorySource :: historySource, envHistorySource :: historySource,
envQtisEndpoint :: T.Text,
envStrategyInstanceParams :: StrategyInstanceParams, envStrategyInstanceParams :: StrategyInstanceParams,
envStrategyEnvironment :: IORef StrategyEnvironment, envStrategyEnvironment :: IORef StrategyEnvironment,
envConfigRef :: IORef c, envConfigRef :: IORef c,
@ -172,6 +176,20 @@ instance MonadHistory (App QQ.QHPHandle c s) where
qhp <- asks envHistorySource qhp <- asks envHistorySource
QQ.requestHistoryFromQHP qhp tickerId timeframe fromTime toTime QQ.requestHistoryFromQHP qhp tickerId timeframe fromTime toTime
instance MonadInstrumentParametersSource (App hs c s) where
getInstrumentParameters tickerIds = do
ctx <- asks envZeromqContext
ep <- asks envQtisEndpoint
info <- liftIO $ qtisGetTickersInfo ctx ep tickerIds
return $ (tiTicker info, convert info)
where
convert info = InstrumentParameters
{
ipLotSize = fromInteger $ tiLotSize info,
ipTickSize = tiTickSize info
}
data BigConfig c = BigConfig { data BigConfig c = BigConfig {
confTickers :: [Ticker], confTickers :: [Ticker],
strategyConfig :: c strategyConfig :: c
@ -205,9 +223,6 @@ storeState params stateRef timersRef = do
Left _ -> warningM "main" "Unable to save state" Left _ -> warningM "main" "Unable to save state"
Right _ -> return () Right _ -> return ()
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
infoM "main" "Shutdown, saving state" infoM "main" "Shutdown, saving state"
@ -215,8 +230,8 @@ gracefulShutdown params stateRef timersRef shutdownMv _ = do
putMVar shutdownMv () putMVar shutdownMv ()
exitSuccess exitSuccess
robotMain :: (ToJSON s, FromJSON s, FromJSON c) => DiffTime -> s -> Maybe (InitializationCallback c) -> EventCallback c s -> IO () robotMain :: (ToJSON s, FromJSON s, FromJSON c) => DiffTime -> s -> EventCallback c s -> IO ()
robotMain dataDownloadDelta defaultState initCallback callback = do robotMain dataDownloadDelta defaultState callback = do
params <- execParser opts params <- execParser opts
initLogging params initLogging params
infoM "main" "Starting" infoM "main" "Starting"
@ -230,14 +245,10 @@ robotMain dataDownloadDelta defaultState initCallback callback = do
strategyAccount = T.pack . accountId $ params, strategyAccount = T.pack . accountId $ params,
strategyVolume = volumeFactor params, strategyVolume = volumeFactor params,
tickers = tickerList, tickers = tickerList,
strategyQTISEp = T.pack <$> qtisSocket params} strategyQTISEp = Nothing }
updatedConfig <- case initCallback of
Just cb -> cb config instanceParams
Nothing -> return config
stateRef <- newIORef stratState stateRef <- newIORef stratState
configRef <- newIORef updatedConfig configRef <- newIORef config
timersRef <- newIORef timersState timersRef <- newIORef timersState
shutdownMv <- newEmptyMVar shutdownMv <- newEmptyMVar
installHandler sigINT (gracefulShutdown params stateRef timersRef shutdownMv) installHandler sigINT (gracefulShutdown params stateRef timersRef shutdownMv)
@ -273,6 +284,8 @@ robotMain dataDownloadDelta defaultState initCallback callback = do
now <- getCurrentTime >>= newIORef now <- getCurrentTime >>= newIORef
let env = Env { let env = Env {
envZeromqContext = ctx,
envQtisEndpoint = T.pack . qtisEndpoint $ params,
envHistorySource = mkQHPHandle ctx (T.pack . fromMaybe "" . historyProvider $ params), envHistorySource = mkQHPHandle ctx (T.pack . fromMaybe "" . historyProvider $ params),
envStrategyInstanceParams = instanceParams, envStrategyInstanceParams = instanceParams,
envStrategyEnvironment = straEnv, envStrategyEnvironment = straEnv,
@ -393,7 +406,8 @@ barStrategyDriver downloadDelta instanceParams callback shutdownVar = do
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) `addUTCTime` now) now ((fromRational . toRational . negate $ downloadDelta) `addUTCTime` now) now
return (code t, BarSeries (code t) (Timeframe (timeframeSeconds t)) history) instrumentParams <- snd <$> getInstrumentParameters (code t)
return (code t, BarSeries (code t) (Timeframe (timeframeSeconds t)) history instrumentParams)
readAndHandleEvents agg instanceParams' = do readAndHandleEvents agg instanceParams' = do
eventChan <- asks envEventChan eventChan <- asks envEventChan

1
src/ATrade/Exceptions.hs
Unescape View File

@ -13,6 +13,7 @@ data RoboComException = UnableToLoadConfig T.Text
| UnableToLoadState T.Text | UnableToLoadState T.Text
| UnableToSaveState T.Text | UnableToSaveState T.Text
| BadParams T.Text | BadParams T.Text
| QTISFailure T.Text
deriving (Show, Generic) deriving (Show, Generic)
instance Exception RoboComException instance Exception RoboComException

10
src/ATrade/Quotes.hs
Unescape View File

@ -7,13 +7,17 @@
module ATrade.Quotes module ATrade.Quotes
( (
MonadHistory(..) MonadHistory(..)
, MonadInstrumentParametersSource(..)
) where ) where
import ATrade.Types (Bar, BarTimeframe, TickerId) import ATrade.RoboCom.Types (InstrumentParameters (..))
import Data.Time.Clock (UTCTime) import ATrade.Types (Bar, BarTimeframe, TickerId)
import Data.Time.Clock (UTCTime)
class (Monad m) => MonadHistory m where class (Monad m) => MonadHistory m where
-- | 'getHistory tickerId timeframe fromTime toTime' should return requested timeframe between 'fromTime' and 'toTime' -- | 'getHistory tickerId timeframe fromTime toTime' should return requested timeframe between 'fromTime' and 'toTime'
getHistory :: TickerId -> BarTimeframe -> UTCTime -> UTCTime -> m [Bar] getHistory :: TickerId -> BarTimeframe -> UTCTime -> UTCTime -> m [Bar]
class (Monad m) => MonadInstrumentParametersSource m where
getInstrumentParameters :: TickerId -> m (TickerId, InstrumentParameters)

39
src/ATrade/Quotes/QTIS.hs
Unescape View File

@ -3,17 +3,16 @@
module ATrade.Quotes.QTIS module ATrade.Quotes.QTIS
( (
TickerInfo(..), TickerInfo(..),
qtisGetTickersInfo, qtisGetTickersInfo
qtisGetTickersInfo'
) where ) where
import ATrade.Exceptions
import ATrade.Types import ATrade.Types
import Control.Monad import Control.Exception.Safe
import Data.Aeson import Data.Aeson
import qualified Data.ByteString.Char8 as BC8 import qualified Data.ByteString.Char8 as BC8
import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy as BL
import Data.Maybe import qualified Data.Text as T
import qualified Data.Text as T
import System.Log.Logger import System.Log.Logger
import System.ZMQ4 import System.ZMQ4
@ -35,23 +34,21 @@ instance ToJSON TickerInfo where
"lot_size" .= tiLotSize ti, "lot_size" .= tiLotSize ti,
"tick_size" .= tiTickSize ti ] "tick_size" .= tiTickSize ti ]
qtisGetTickersInfo' :: T.Text -> [TickerId] -> IO [TickerInfo] qtisGetTickersInfo :: Context -> T.Text -> TickerId -> IO TickerInfo
qtisGetTickersInfo' endpoint tickers = withContext (\ctx -> qtisGetTickersInfo ctx endpoint tickers) qtisGetTickersInfo ctx endpoint tickerId =
withSocket ctx Req $ \sock -> do
qtisGetTickersInfo :: Context -> T.Text -> [TickerId] -> IO [TickerInfo]
qtisGetTickersInfo ctx endpoint tickers =
withSocket ctx Req (\sock -> do
debugM "QTIS" $ "Connecting to: " ++ T.unpack endpoint debugM "QTIS" $ "Connecting to: " ++ T.unpack endpoint
connect sock $ T.unpack endpoint connect sock $ T.unpack endpoint
catMaybes <$> forM tickers (\tickerId -> do debugM "QTIS" $ "Requesting: " ++ T.unpack tickerId
debugM "QTIS" $ "Requesting: " ++ T.unpack tickerId send sock [] $ BL.toStrict tickerRequest
send sock [] $ BL.toStrict (tickerRequest tickerId) response <- receiveMulti sock
response <- receiveMulti sock let r = parseResponse response
let r = parseResponse response debugM "QTIS" $ "Got response: " ++ show r
debugM "QTIS" $ "Got response: " ++ show r case r of
return r)) Just resp -> return resp
Nothing -> throw $ QTISFailure "Can't parse response"
where where
tickerRequest tickerId = encode $ object ["ticker" .= tickerId] tickerRequest = encode $ object ["ticker" .= tickerId]
parseResponse :: [BC8.ByteString] -> Maybe TickerInfo parseResponse :: [BC8.ByteString] -> Maybe TickerInfo
parseResponse (header:payload:_) = if header == "OK" parseResponse (header:payload:_) = if header == "OK"
then decode $ BL.fromStrict payload then decode $ BL.fromStrict payload

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

@ -10,7 +10,8 @@ module ATrade.RoboCom.Types (
Timeframe(..), Timeframe(..),
tfSeconds, tfSeconds,
Ticker(..), Ticker(..),
Bars Bars,
InstrumentParameters(..)
) where ) where
import ATrade.Types import ATrade.Types
@ -26,11 +27,18 @@ newtype Timeframe =
tfSeconds :: (Num a) => Timeframe -> a tfSeconds :: (Num a) => Timeframe -> a
tfSeconds (Timeframe s) = fromInteger s tfSeconds (Timeframe s) = fromInteger s
data InstrumentParameters =
InstrumentParameters {
ipLotSize :: Int,
ipTickSize :: Price
} deriving (Show, Eq)
data BarSeries = data BarSeries =
BarSeries { BarSeries {
bsTickerId :: TickerId, bsTickerId :: TickerId,
bsTimeframe :: Timeframe, bsTimeframe :: Timeframe,
bsBars :: [Bar] bsBars :: [Bar],
bsParams :: InstrumentParameters
} deriving (Show, Eq) } deriving (Show, Eq)
-- | Ticker description record -- | Ticker description record

Write Preview
Loading…
Cancel
Save