18 changed files with 437 additions and 350 deletions
@ -0,0 +1,147 @@
@@ -0,0 +1,147 @@
|
||||
{-# LANGUAGE DeriveGeneric #-} |
||||
{-# LANGUAGE LambdaCase #-} |
||||
|
||||
module ATrade.Driver.Junction.QuoteThread |
||||
( |
||||
QuoteThreadHandle, |
||||
startQuoteThread, |
||||
stopQuoteThread, |
||||
addSubscription |
||||
) where |
||||
|
||||
import ATrade.Quotes.HistoryProvider (HistoryProvider (..)) |
||||
import ATrade.Quotes.TickerInfoProvider (TickerInfoProvider (..)) |
||||
import ATrade.QuoteSource.Client (QuoteData (QDBar, QDTick), |
||||
QuoteSourceClientHandle, |
||||
quoteSourceClientSubscribe, |
||||
startQuoteSourceClient, |
||||
stopQuoteSourceClient) |
||||
import ATrade.RoboCom.Types (Bar (barSecurity), |
||||
BarSeries (..), |
||||
BarSeriesId (BarSeriesId), |
||||
Bars, InstrumentParameters) |
||||
import ATrade.Types (BarTimeframe (BarTimeframe), ClientSecurityParams (ClientSecurityParams), |
||||
Tick (security), TickerId) |
||||
import Control.Concurrent (ThreadId, forkIO, killThread) |
||||
import Control.Concurrent.BoundedChan (BoundedChan, newBoundedChan, |
||||
readChan, writeChan) |
||||
import Control.Monad (forever) |
||||
import Control.Monad.Reader (MonadIO (liftIO), |
||||
ReaderT (runReaderT), lift) |
||||
import Control.Monad.Reader.Class (asks) |
||||
import Data.Hashable (Hashable) |
||||
import qualified Data.HashMap.Strict as HM |
||||
import Data.IORef (IORef, atomicModifyIORef', |
||||
newIORef, readIORef) |
||||
import qualified Data.Map.Strict as M |
||||
import qualified Data.Text as T |
||||
import Data.Time (addUTCTime, getCurrentTime) |
||||
import GHC.Generics (Generic) |
||||
import System.ZMQ4 (Context) |
||||
import System.ZMQ4.ZAP (CurveCertificate) |
||||
|
||||
data QuoteSubscription = |
||||
QuoteSubscription TickerId BarTimeframe |
||||
deriving (Generic, Eq) |
||||
|
||||
instance Hashable BarTimeframe |
||||
instance Hashable QuoteSubscription |
||||
|
||||
data QuoteThreadHandle = QuoteThreadHandle ThreadId ThreadId QuoteThreadEnv |
||||
|
||||
data QuoteThreadEnv = |
||||
QuoteThreadEnv |
||||
{ |
||||
bars :: IORef Bars, |
||||
endpoints :: IORef (HM.HashMap QuoteSubscription [BoundedChan QuoteData]), |
||||
qsclient :: QuoteSourceClientHandle, |
||||
paramsCache :: IORef (M.Map TickerId InstrumentParameters), |
||||
historyProvider :: HistoryProvider, |
||||
tickerInfoProvider :: TickerInfoProvider, |
||||
downloaderChan :: BoundedChan QuoteSubscription |
||||
} |
||||
|
||||
startQuoteThread :: (MonadIO m) => |
||||
IORef Bars -> |
||||
Context -> |
||||
T.Text -> |
||||
Maybe CurveCertificate -> |
||||
Maybe CurveCertificate -> |
||||
HistoryProvider -> |
||||
TickerInfoProvider -> |
||||
m QuoteThreadHandle |
||||
startQuoteThread barsRef ctx ep clientCert serverCert hp tip = do |
||||
chan <- liftIO $ newBoundedChan 2000 |
||||
dChan <- liftIO $ newBoundedChan 2000 |
||||
qsc <- liftIO $ startQuoteSourceClient chan [] ctx ep (ClientSecurityParams clientCert serverCert) |
||||
env <- liftIO $ QuoteThreadEnv barsRef <$> newIORef HM.empty <*> pure qsc <*> newIORef M.empty <*> pure hp <*> pure tip <*> pure dChan |
||||
tid <- liftIO . forkIO $ quoteThread env chan |
||||
downloaderTid <- liftIO . forkIO $ downloaderThread env dChan |
||||
return $ QuoteThreadHandle tid downloaderTid env |
||||
where |
||||
downloaderThread env chan = forever $ do |
||||
QuoteSubscription tickerid tf <- readChan chan |
||||
paramsMap <- liftIO $ readIORef $ paramsCache env |
||||
mbParams <- case M.lookup tickerid paramsMap of |
||||
Nothing -> do |
||||
paramsList <- liftIO $ getInstrumentParameters (tickerInfoProvider env) [tickerid] |
||||
case paramsList of |
||||
(params:_) -> liftIO $ atomicModifyIORef' (paramsCache env) (\m -> (M.insert tickerid params m, Just params)) |
||||
_ -> return Nothing |
||||
Just params -> return $ Just params |
||||
barsMap <- readIORef (bars env) |
||||
case M.lookup (BarSeriesId tickerid tf) barsMap of |
||||
Just _ -> return () -- already downloaded |
||||
Nothing -> case mbParams of |
||||
Just params -> do |
||||
now <- liftIO getCurrentTime |
||||
barsData <- liftIO $ getHistory (historyProvider env) tickerid tf ((-86400 * 60) `addUTCTime` now) now |
||||
let barSeries = BarSeries tickerid tf barsData params |
||||
atomicModifyIORef' (bars env) (\m -> (M.insert (BarSeriesId tickerid tf) barSeries m, ())) |
||||
_ -> return () -- TODO log |
||||
|
||||
|
||||
quoteThread env chan = flip runReaderT env $ forever $ do |
||||
qssData <- lift $ readChan chan |
||||
case qssData of |
||||
QDBar (tf, bar) -> do |
||||
barsRef' <- asks bars |
||||
lift $ atomicModifyIORef' barsRef' (\x -> (updateBarsMap x bar tf, ())) |
||||
_ -> return () -- TODO pass to bar aggregator |
||||
let key = case qssData of |
||||
QDTick tick -> QuoteSubscription (security tick) (BarTimeframe 0) |
||||
QDBar (tf, bar) -> QuoteSubscription (barSecurity bar) tf |
||||
subs <- asks endpoints >>= (lift . readIORef) |
||||
case HM.lookup key subs of |
||||
Just clientChannels -> do |
||||
lift $ mapM_ (`writeChan` qssData) clientChannels |
||||
Nothing -> return () |
||||
|
||||
stopQuoteThread :: (MonadIO m) => QuoteThreadHandle -> m () |
||||
stopQuoteThread (QuoteThreadHandle tid dtid env) = liftIO $ do |
||||
killThread tid |
||||
killThread dtid |
||||
stopQuoteSourceClient (qsclient env) |
||||
|
||||
addSubscription :: (MonadIO m) => QuoteThreadHandle -> TickerId -> BarTimeframe -> BoundedChan QuoteData -> m () |
||||
addSubscription (QuoteThreadHandle _ _ env) tid tf chan = liftIO $ do |
||||
writeChan (downloaderChan env) (QuoteSubscription tid tf) |
||||
atomicModifyIORef' (endpoints env) (\m -> (doAddSubscription m tid, ())) |
||||
quoteSourceClientSubscribe (qsclient env) [(tid, BarTimeframe 0)] |
||||
where |
||||
doAddSubscription m tickerid = |
||||
let m1 = HM.alter (\case |
||||
Just chans -> Just (chan : chans) |
||||
_ -> Just [chan]) (QuoteSubscription tickerid tf) m in |
||||
HM.alter (\case |
||||
Just chans -> Just (chan : chans) |
||||
_ -> Just [chan]) (QuoteSubscription tickerid (BarTimeframe 0)) m1 |
||||
|
||||
updateBarsMap :: Bars -> Bar -> BarTimeframe -> Bars |
||||
updateBarsMap barsMap bar tf = M.adjust (addToSeries bar) (BarSeriesId (barSecurity bar) tf) barsMap |
||||
|
||||
addToSeries :: Bar -> BarSeries -> BarSeries |
||||
addToSeries bar series = series { bsBars = bar : bsBars series } |
||||
|
||||
|
||||
|
||||
@ -0,0 +1,14 @@
@@ -0,0 +1,14 @@
|
||||
|
||||
module ATrade.Quotes.HistoryProvider |
||||
( |
||||
HistoryProvider(..) |
||||
) where |
||||
|
||||
import ATrade.RoboCom.Types (Bar) |
||||
import ATrade.Types (BarTimeframe, TickerId) |
||||
import Data.Time (UTCTime) |
||||
newtype HistoryProvider = |
||||
HistoryProvider |
||||
{ |
||||
getHistory :: TickerId -> BarTimeframe -> UTCTime -> UTCTime -> IO [Bar] |
||||
} |
||||
@ -0,0 +1,13 @@
@@ -0,0 +1,13 @@
|
||||
|
||||
module ATrade.Quotes.TickerInfoProvider |
||||
( |
||||
TickerInfoProvider(..) |
||||
) where |
||||
|
||||
import ATrade.RoboCom.Types (InstrumentParameters) |
||||
import ATrade.Types (TickerId) |
||||
newtype TickerInfoProvider = |
||||
TickerInfoProvider |
||||
{ |
||||
getInstrumentParameters :: [TickerId] -> IO [InstrumentParameters] |
||||
} |
||||
@ -0,0 +1,82 @@
@@ -0,0 +1,82 @@
|
||||
{-# LANGUAGE OverloadedStrings #-} |
||||
|
||||
module Test.Driver.Junction.QuoteThread |
||||
( |
||||
unitTests |
||||
) where |
||||
|
||||
import Test.Tasty |
||||
import Test.Tasty.HUnit |
||||
import Test.Tasty.QuickCheck as QC |
||||
import Test.Tasty.SmallCheck as SC |
||||
|
||||
import ATrade.Driver.Junction.QuoteThread (addSubscription, |
||||
startQuoteThread, |
||||
stopQuoteThread) |
||||
import ATrade.QuoteSource.Client (QuoteData (QDBar)) |
||||
import ATrade.QuoteSource.Server (QuoteSourceServerData (..), |
||||
startQuoteSourceServer, |
||||
stopQuoteSourceServer) |
||||
import ATrade.RoboCom.Types (BarSeries (bsBars), |
||||
BarSeriesId (BarSeriesId), |
||||
InstrumentParameters (InstrumentParameters)) |
||||
import ATrade.Types |
||||
import Control.Concurrent (forkIO, threadDelay) |
||||
import Control.Concurrent.BoundedChan (newBoundedChan, readChan, |
||||
writeChan) |
||||
import Control.Exception (bracket) |
||||
import Control.Monad (forever) |
||||
import Data.IORef (newIORef, readIORef) |
||||
import qualified Data.Map.Strict as M |
||||
import qualified Data.Text as T |
||||
import Data.Time (UTCTime (UTCTime), |
||||
fromGregorian) |
||||
import System.IO (BufferMode (LineBuffering), |
||||
hSetBuffering, stderr) |
||||
import System.Log.Formatter |
||||
import System.Log.Handler (setFormatter) |
||||
import System.Log.Handler.Simple |
||||
import System.Log.Logger |
||||
import System.ZMQ4 (withContext) |
||||
import Test.Mock.HistoryProvider (mkMockHistoryProvider) |
||||
import Test.Mock.TickerInfoProvider (mkMockTickerInfoProvider) |
||||
|
||||
qsEndpoint = "inproc://qs" |
||||
|
||||
mockHistoryProvider = mkMockHistoryProvider $ M.fromList [(BarSeriesId "FOO" (BarTimeframe 3600), bars)] |
||||
where |
||||
bars = [] |
||||
|
||||
mockTickerInfoProvider = mkMockTickerInfoProvider $ M.fromList [("FOO", InstrumentParameters 10 0.1)] |
||||
|
||||
unitTests = testGroup "Driver.Junction.QuoteThread" [ |
||||
testSubscription |
||||
] |
||||
|
||||
testSubscription :: TestTree |
||||
testSubscription = testCase "Subscription" $ withContext $ \ctx -> do |
||||
barsRef <- newIORef M.empty |
||||
serverChan <- newBoundedChan 2000 |
||||
bracket |
||||
(startQuoteSourceServer serverChan ctx qsEndpoint defaultServerSecurityParams) |
||||
stopQuoteSourceServer $ \_ -> |
||||
bracket |
||||
(startQuoteThread barsRef ctx qsEndpoint Nothing Nothing mockHistoryProvider mockTickerInfoProvider) |
||||
stopQuoteThread $ \qt -> do |
||||
chan <- newBoundedChan 2000 |
||||
addSubscription qt "FOO" (BarTimeframe 3600) chan |
||||
|
||||
forkIO $ forever $ threadDelay 50000 >> writeChan serverChan (QSSBar (BarTimeframe 3600, bar)) |
||||
|
||||
clientData <- readChan chan |
||||
assertEqual "Invalid client data" clientData (QDBar (BarTimeframe 3600, bar)) |
||||
|
||||
bars <- readIORef barsRef |
||||
case M.lookup (BarSeriesId "FOO" (BarTimeframe 3600)) bars of |
||||
Just series -> assertBool "Length should be >= 1" $ (not . null . bsBars) series |
||||
Nothing -> assertFailure "Bar Series should be present" |
||||
where |
||||
bar = |
||||
Bar { |
||||
barSecurity="FOO", barTimestamp=UTCTime (fromGregorian 2021 11 20) 7200, barOpen=10, barHigh=12, barLow=9, barClose=11, barVolume=100 |
||||
} |
||||
@ -0,0 +1,25 @@
@@ -0,0 +1,25 @@
|
||||
|
||||
module Test.Mock.HistoryProvider |
||||
( |
||||
mkMockHistoryProvider |
||||
) where |
||||
|
||||
import ATrade.Quotes.HistoryProvider |
||||
import ATrade.RoboCom.Types (BarSeriesId (BarSeriesId), Bars) |
||||
import ATrade.Types (Bar (Bar, barTimestamp), |
||||
BarTimeframe (BarTimeframe), |
||||
TickerId) |
||||
import qualified Data.Map.Strict as M |
||||
import Data.Time (UTCTime) |
||||
|
||||
mkMockHistoryProvider :: M.Map BarSeriesId [Bar] -> HistoryProvider |
||||
mkMockHistoryProvider bars = HistoryProvider $ mockGetHistory bars |
||||
|
||||
mockGetHistory :: M.Map BarSeriesId [Bar] -> TickerId -> BarTimeframe -> UTCTime -> UTCTime -> IO [Bar] |
||||
mockGetHistory bars tid tf from to = |
||||
case M.lookup (BarSeriesId tid tf) bars of |
||||
Just series -> return $ filter (\bar -> (barTimestamp bar >= from) && (barTimestamp bar <= to)) series |
||||
Nothing -> return [] |
||||
|
||||
|
||||
|
||||
@ -0,0 +1,17 @@
@@ -0,0 +1,17 @@
|
||||
|
||||
module Test.Mock.TickerInfoProvider |
||||
( |
||||
mkMockTickerInfoProvider |
||||
) where |
||||
|
||||
import ATrade.Quotes.TickerInfoProvider |
||||
import ATrade.RoboCom.Types (InstrumentParameters) |
||||
import ATrade.Types (TickerId) |
||||
import qualified Data.Map.Strict as M |
||||
import Data.Maybe (catMaybes, mapMaybe) |
||||
|
||||
mkMockTickerInfoProvider :: M.Map TickerId InstrumentParameters -> TickerInfoProvider |
||||
mkMockTickerInfoProvider params = TickerInfoProvider $ mockGetInstrumentParameters params |
||||
|
||||
mockGetInstrumentParameters :: M.Map TickerId InstrumentParameters -> [TickerId] -> IO [InstrumentParameters] |
||||
mockGetInstrumentParameters params = return . mapMaybe (`M.lookup` params) |
||||
@ -1,167 +0,0 @@
@@ -1,167 +0,0 @@
|
||||
|
||||
{-# LANGUAGE OverloadedStrings #-} |
||||
|
||||
module Test.RoboCom.Positions |
||||
( |
||||
unitTests |
||||
) where |
||||
|
||||
import Test.Tasty |
||||
import Test.Tasty.HUnit |
||||
import Test.Tasty.QuickCheck as QC |
||||
import Test.Tasty.SmallCheck as SC |
||||
|
||||
import ATrade.Types |
||||
import qualified Data.Text as T |
||||
import qualified Data.Map.Strict as M |
||||
import Data.Time.Calendar |
||||
import Data.Time.Clock |
||||
import qualified Data.List as L |
||||
|
||||
import ATrade.RoboCom.Monad |
||||
import ATrade.RoboCom.Positions |
||||
import ATrade.RoboCom.Types |
||||
|
||||
data TestState = TestState |
||||
{ |
||||
positions :: [Position], |
||||
testInt :: Int |
||||
} |
||||
|
||||
defaultState = TestState { |
||||
positions = [], |
||||
testInt = 0 |
||||
} |
||||
|
||||
data TestConfig = TestConfig |
||||
|
||||
instance ParamsHasMainTicker TestConfig where |
||||
mainTicker _ = "TEST_TICKER" |
||||
|
||||
instance StateHasPositions TestState where |
||||
getPositions = positions |
||||
setPositions a p = a { positions = p } |
||||
|
||||
defaultStrategyEnvironment = StrategyEnvironment |
||||
{ |
||||
seInstanceId = "test_instance", |
||||
seAccount = "test_account", |
||||
seVolume = 1, |
||||
seBars = M.empty, |
||||
seLastTimestamp = (UTCTime (fromGregorian 1970 1 1) 0) |
||||
} |
||||
|
||||
unitTests = testGroup "RoboCom.Positions" [ |
||||
testEnterAtMarket, |
||||
testEnterAtMarketSendsAction, |
||||
testDefaultHandlerSubmissionDeadline, |
||||
testDefaultHandlerAfterSubmissionPositionIsWaitingOpen, |
||||
testDefaultHandlerPositionWaitingOpenOrderOpenExecuted1 |
||||
] |
||||
|
||||
testEnterAtMarket = testCase "enterAtMarket creates position in PositionWaitingOpenSubmission state" $ do |
||||
let (newState, actions, _) = runStrategyElement TestConfig defaultState defaultStrategyEnvironment element |
||||
assertBool "Should be exactly 1 position" ((length . positions) newState == 1) |
||||
let pos = head . positions $ newState |
||||
assertBool "Should be in PositionWaitingOpenSubmission" (isPositionWaitingOpenSubmission . posState $ pos) |
||||
let (PositionWaitingOpenSubmission order) = posState pos |
||||
assertBool "Account should be 'test_account'" (orderAccountId order == "test_account") |
||||
assertBool "Security should be 'TEST_TICKER'" (orderSecurity order == "TEST_TICKER") |
||||
assertBool "Order price should be Market" (orderPrice order == Market) |
||||
assertBool "Order quantity should be 1" (orderQuantity order == 1) |
||||
assertBool "Executed order quantity should be 0" (orderExecutedQuantity order == 0) |
||||
assertBool "Order operation should be Buy" (orderOperation order == Buy) |
||||
assertBool "Order signal id should be correct" (orderSignalId order == (SignalId "test_instance" "long" "")) |
||||
where |
||||
element = enterAtMarket "long" Buy |
||||
|
||||
isPositionWaitingOpenSubmission (PositionWaitingOpenSubmission _) = True |
||||
isPositionWaitingOpenSubmission _ = False |
||||
|
||||
testEnterAtMarketSendsAction = testCase "enterAtMarket sends ActionSubmitOrder" $ do |
||||
let (newState, actions, _) = runStrategyElement TestConfig defaultState defaultStrategyEnvironment element |
||||
case (L.find isActionOrder actions) of |
||||
Just (ActionOrder order) -> do |
||||
assertBool "Account should be 'test_account'" (orderAccountId order == "test_account") |
||||
assertBool "Security should be 'TEST_TICKER'" (orderSecurity order == "TEST_TICKER") |
||||
assertBool "Order price should be Market" (orderPrice order == Market) |
||||
assertBool "Order quantity should be 1" (orderQuantity order == 1) |
||||
assertBool "Executed order quantity should be 0" (orderExecutedQuantity order == 0) |
||||
assertBool "Order operation should be Buy" (orderOperation order == Buy) |
||||
assertBool "Order signal id should be correct" (orderSignalId order == (SignalId "test_instance" "long" "")) |
||||
Nothing -> assertFailure "Should be exactly 1 ActionOrder" |
||||
where |
||||
element = enterAtMarket "long" Buy |
||||
|
||||
isActionOrder (ActionOrder _) = True |
||||
isActionOrder _ = False |
||||
|
||||
testDefaultHandlerSubmissionDeadline = testCase "defaultHandler after submission deadline marks position as cancelled" $ do |
||||
let (newState, actions, _) = runStrategyElement TestConfig defaultState defaultStrategyEnvironment element |
||||
let (newState', actions', _) = runStrategyElement TestConfig newState defaultStrategyEnvironment { seLastTimestamp = afterDeadline } $ defaultHandler (NewTick tick) |
||||
let pos = head . positions $ newState' |
||||
assertBool "Cancelled position" (posState pos == PositionCancelled) |
||||
where |
||||
element = enterAtMarket "long" Buy |
||||
afterDeadline = (UTCTime (fromGregorian 1970 1 1) 100) |
||||
tick = Tick { |
||||
security = "TEST_TICKER", |
||||
datatype = LastTradePrice, |
||||
timestamp = afterDeadline, |
||||
value = fromDouble 12.00, |
||||
volume = 1 } |
||||
|
||||
testDefaultHandlerAfterSubmissionPositionIsWaitingOpen = testCase "defaultHandler after successful submission sets position state as PositionWaitingOpen" $ do |
||||
let (newState, actions, _) = runStrategyElement TestConfig defaultState defaultStrategyEnvironment element |
||||
let pos = head . positions $ newState |
||||
let (PositionWaitingOpenSubmission order) = posState pos |
||||
let (newState', actions', _) = runStrategyElement TestConfig newState defaultStrategyEnvironment { seLastTimestamp = beforeDeadline } $ defaultHandler (OrderSubmitted order {orderId = 1 }) |
||||
let pos' = head . positions $ newState' |
||||
assertEqual "New position state should be PositionWaitingOpen" (posState pos') PositionWaitingOpen |
||||
where |
||||
element = enterAtMarket "long" Buy |
||||
beforeDeadline = (UTCTime (fromGregorian 1970 1 1) 1) |
||||
|
||||
testDefaultHandlerPositionWaitingOpenOrderCancelledExecuted0 = testCase "defaultHandler in PositionWaitingOpen, if order is cancelled and nothing is executed, marks position as cancelled" $ do |
||||
let (newState, actions, _) = runStrategyElement TestConfig defaultState defaultStrategyEnvironment element |
||||
let pos = head . positions $ newState |
||||
let (PositionWaitingOpenSubmission order) = posState pos |
||||
let (newState', actions', _) = runStrategyElement TestConfig newState defaultStrategyEnvironment { seLastTimestamp = ts1 } $ defaultHandler (OrderSubmitted order {orderId = 1 }) |
||||
let (newState'', actions'', _) = runStrategyElement TestConfig newState defaultStrategyEnvironment { seLastTimestamp = ts2 } $ defaultHandler (OrderUpdate 1 Cancelled) |
||||
let pos = head . positions $ newState'' |
||||
assertEqual "New position state should be PositionCancelled" (posState pos) PositionCancelled |
||||
where |
||||
element = enterAtMarket "long" Buy |
||||
ts1 = (UTCTime (fromGregorian 1970 1 1) 1) |
||||
ts2 = (UTCTime (fromGregorian 1970 1 1) 2) |
||||
|
||||
testDefaultHandlerPositionWaitingOpenOrderOpenExecuted1 = testCase "defaultHandler in PositionWaitingOpen, if order is cancelled and something is executed, marks position as open" $ do |
||||
let (newState, actions, _) = runStrategyElement TestConfig defaultState defaultStrategyEnvironment element |
||||
let pos = head . positions $ newState |
||||
let (PositionWaitingOpenSubmission order) = posState pos |
||||
let (newState', actions', _) = runStrategyElement TestConfig newState defaultStrategyEnvironment { seLastTimestamp = ts1, seVolume = 2 } $ defaultHandler (OrderSubmitted order {orderId = 1 }) |
||||
let (newState'', actions'', _) = runStrategyElement TestConfig newState' defaultStrategyEnvironment { seLastTimestamp = ts2 } $ defaultHandler (NewTrade trade) |
||||
let (newState''', actions''', _) = runStrategyElement TestConfig newState'' defaultStrategyEnvironment { seLastTimestamp = ts3 } $ defaultHandler (OrderUpdate 1 Cancelled) |
||||
let pos = head . positions $ newState''' |
||||
assertEqual "New position state should be PositionOpen" (posState pos) PositionOpen |
||||
where |
||||
element = enterAtMarket "long" Buy |
||||
ts1 = (UTCTime (fromGregorian 1970 1 1) 1) |
||||
ts2 = (UTCTime (fromGregorian 1970 1 1) 2) |
||||
ts3 = (UTCTime (fromGregorian 1970 1 1) 3) |
||||
trade = Trade |
||||
{ |
||||
tradeOrderId = 1, |
||||
tradePrice = fromDouble 10, |
||||
tradeQuantity = 1, |
||||
tradeVolume = fromDouble 10, |
||||
tradeVolumeCurrency = "FOO", |
||||
tradeOperation = Buy, |
||||
tradeAccount = "test_account", |
||||
tradeSecurity = "TEST_TICKER", |
||||
tradeTimestamp = ts3, |
||||
tradeCommission = fromDouble 0, |
||||
tradeSignalId = SignalId "test_instance" "long" "" |
||||
} |
||||
|
||||
|
||||
Loading…
Reference in new issue