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

Got rid of Data.Decimal (using libatrade-0.3.0.0)

master
Denis Tereshkin 8 years ago
parent
f5a29e8098
commit
c16d323d21
7 changed files with 57 additions and 45 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. 6
      app/Config.hs
  2. 43
      app/Main.hs
  3. 4
      quik-connector.cabal
  4. 13
      src/Broker/PaperBroker.hs
  5. 5
      src/Broker/QuikBroker.hs
  6. 20
      src/QuoteSource/PipeReader.hs
  7. 11
      src/QuoteSource/TableParsers/AllParamsTableParser.hs

6
app/Config.hs
Unescape View File

@ -22,6 +22,8 @@ data TableConfig = TableConfig {
data Config = Config { data Config = Config {
quotesourceEndpoint :: String, quotesourceEndpoint :: String,
pipeReaderQsEndpoint :: Maybe String,
tickPipePath :: Maybe String,
brokerserverEndpoint :: String, brokerserverEndpoint :: String,
whitelist :: [T.Text], whitelist :: [T.Text],
blacklist :: [T.Text], blacklist :: [T.Text],
@ -46,6 +48,8 @@ readConfig fname = do
parseConfig :: Value -> Parser Config parseConfig :: Value -> Parser Config
parseConfig = withObject "object" $ \obj -> do parseConfig = withObject "object" $ \obj -> do
qse <- obj .: "quotesource-endpoint" qse <- obj .: "quotesource-endpoint"
qsePipe <- obj .:? "quotesource-endpoint-pipe-reader"
pipePath <- obj .:? "pipe-reader-path"
bse <- obj .: "brokerserver-endpoint" bse <- obj .: "brokerserver-endpoint"
whitelist' <- obj .:? "whitelist" .!= [] whitelist' <- obj .:? "whitelist" .!= []
blacklist' <- obj .:? "blacklist" .!= [] blacklist' <- obj .:? "blacklist" .!= []
@ -61,6 +65,8 @@ parseConfig = withObject "object" $ \obj -> do
tgChatId <- obj .: "telegram-chatid" tgChatId <- obj .: "telegram-chatid"
accs <- V.toList <$> obj .: "accounts" accs <- V.toList <$> obj .: "accounts"
return Config { quotesourceEndpoint = qse, return Config { quotesourceEndpoint = qse,
pipeReaderQsEndpoint = qsePipe,
tickPipePath = pipePath,
brokerserverEndpoint = bse, brokerserverEndpoint = bse,
whitelist = whitelist', whitelist = whitelist',
blacklist = blacklist', blacklist = blacklist',

43
app/Main.hs
Unescape View File

@ -1,4 +1,4 @@
{-# LANGUAGE OverloadedStrings, OverloadedLabels #-} {-# LANGUAGE OverloadedStrings, OverloadedLabels, LambdaCase #-}
module Main where module Main where
import System.IO import System.IO
@ -6,7 +6,7 @@ import System.IO
import QuoteSource.DataImport import QuoteSource.DataImport
import Control.Concurrent hiding (readChan, writeChan) import Control.Concurrent hiding (readChan, writeChan)
import Control.Monad import Control.Monad
import Control.Exception import Control.Exception.Safe
import Control.Error.Util import Control.Error.Util
import qualified GI.Gtk as Gtk import qualified GI.Gtk as Gtk
import Data.GI.Base import Data.GI.Base
@ -14,6 +14,7 @@ import Control.Concurrent.BoundedChan
import ATrade.Types import ATrade.Types
import QuoteSource.TableParsers.AllParamsTableParser import QuoteSource.TableParsers.AllParamsTableParser
import QuoteSource.TableParser import QuoteSource.TableParser
import QuoteSource.PipeReader
import ATrade.QuoteSource.Server import ATrade.QuoteSource.Server
import ATrade.Broker.TradeSinks.ZMQTradeSink import ATrade.Broker.TradeSinks.ZMQTradeSink
@ -96,22 +97,32 @@ main = do
let serverParams = defaultServerSecurityParams { sspDomain = Just "global", let serverParams = defaultServerSecurityParams { sspDomain = Just "global",
sspCertificate = serverCert } sspCertificate = serverCert }
withZMQTradeSink ctx (tradeSink config) (\zmqTradeSink -> do bracket (forkIO $ pipeReaderThread ctx config) killThread (\_ -> do
withTelegramTradeSink (telegramToken config) (telegramChatId config) (\telegramTradeSink -> do withZMQTradeSink ctx (tradeSink config) (\zmqTradeSink -> do
bracket (startQuoteSourceServer c2 ctx (T.pack $ quotesourceEndpoint config)) stopQuoteSourceServer (\_ -> do withTelegramTradeSink (telegramToken config) (telegramChatId config) (\telegramTradeSink -> do
bracket (startBrokerServer [brokerP, brokerQ] ctx (T.pack $ brokerserverEndpoint config) [telegramTradeSink, zmqTradeSink] serverParams) stopBrokerServer (\_ -> do bracket (startQuoteSourceServer c2 ctx (T.pack $ quotesourceEndpoint config)) stopQuoteSourceServer (\_ -> do
void $ Gtk.init Nothing bracket (startBrokerServer [brokerP, brokerQ] ctx (T.pack $ brokerserverEndpoint config) [telegramTradeSink, zmqTradeSink] serverParams) stopBrokerServer (\_ -> do
window <- new Gtk.Window [ #title := "Quik connector" ] void $ Gtk.init Nothing
void $ on window #destroy Gtk.mainQuit window <- new Gtk.Window [ #title := "Quik connector" ]
#showAll window void $ on window #destroy Gtk.mainQuit
Gtk.main) #showAll window
infoM "main" "BRS down") Gtk.main)
debugM "main" "QS done") infoM "main" "BRS down")
debugM "main" "TGTS done") debugM "main" "QS done")
debugM "main" "ZMQTS done") debugM "main" "TGTS done")
debugM "main" "ZAP done") debugM "main" "ZMQTS done")
debugM "main" "ZAP done"))
void $ timeout 1000000 $ killThread forkId void $ timeout 1000000 $ killThread forkId
infoM "main" "Main thread done" infoM "main" "Main thread done"
where
pipeReaderThread ctx config =
case (tickPipePath config, pipeReaderQsEndpoint config) of
(Just pipe, Just qsep) -> do
tickChan <- newBoundedChan 10000
bracket (startPipeReader (T.pack pipe) tickChan) stopPipeReader (\_ -> do
bracket (startQuoteSourceServer tickChan ctx (T.pack qsep)) stopQuoteSourceServer (\_ -> threadDelay 1000000))
_ -> return ()
loadCertificatesFromDirectory :: FilePath -> IO [CurveCertificate] loadCertificatesFromDirectory :: FilePath -> IO [CurveCertificate]
loadCertificatesFromDirectory filepath = do loadCertificatesFromDirectory filepath = do

4
quik-connector.cabal
Unescape View File

@ -32,7 +32,6 @@ library
, data-binary-ieee754 , data-binary-ieee754
, bytestring , bytestring
, text , text
, Decimal
, time , time
, vector , vector
, containers , containers
@ -47,7 +46,7 @@ library
, aeson , aeson
, cond , cond
, scientific , scientific
, libatrade , libatrade == 0.3.0.0
, deepseq , deepseq
, errors , errors
, split , split
@ -100,6 +99,7 @@ executable quik-connector-exe
, connection , connection
, directory , directory
, errors , errors
, safe-exceptions
default-language: Haskell2010 default-language: Haskell2010
other-modules: Config other-modules: Config
-- extra-libraries: "user32" -- extra-libraries: "user32"

13
src/Broker/PaperBroker.hs
Unescape View File

@ -18,7 +18,6 @@ import qualified Data.Text as T
import ATrade.Broker.Protocol import ATrade.Broker.Protocol
import ATrade.Broker.Server import ATrade.Broker.Server
import Data.Time.Clock import Data.Time.Clock
import Data.Decimal
import Data.Maybe import Data.Maybe
import Control.Monad import Control.Monad
import Control.Concurrent.BoundedChan import Control.Concurrent.BoundedChan
@ -35,7 +34,7 @@ data PaperBrokerState = PaperBrokerState {
pbTid :: Maybe ThreadId, pbTid :: Maybe ThreadId,
tickMap :: M.Map TickMapKey Tick, tickMap :: M.Map TickMapKey Tick,
orders :: M.Map OrderId Order, orders :: M.Map OrderId Order,
cash :: ! Decimal, cash :: !Price,
notificationCallback :: Maybe (Notification -> IO ()), notificationCallback :: Maybe (Notification -> IO ()),
pendingOrders :: [Order], pendingOrders :: [Order],
@ -53,7 +52,7 @@ data PaperBrokerState = PaperBrokerState {
hourMin :: Integer -> Integer -> DiffTime hourMin :: Integer -> Integer -> DiffTime
hourMin h m = fromIntegral $ h * 3600 + m * 60 hourMin h m = fromIntegral $ h * 3600 + m * 60
mkPaperBroker :: BoundedChan Tick -> Decimal -> [T.Text] -> IO BrokerInterface mkPaperBroker :: BoundedChan Tick -> Price -> [T.Text] -> IO BrokerInterface
mkPaperBroker tickChan startCash accounts = do mkPaperBroker tickChan startCash accounts = do
state <- newIORef PaperBrokerState { state <- newIORef PaperBrokerState {
pbTid = Nothing, pbTid = Nothing,
@ -109,13 +108,13 @@ executePendingOrders tick state = do
else return Nothing else return Nothing
executeLimitAt price order = case orderOperation order of executeLimitAt price order = case orderOperation order of
Buy -> if (datatype tick == Price && price > value tick && value tick > 0) || (datatype tick == BestOffer && price > value tick && value tick > 0) Buy -> if (datatype tick == LastTradePrice && price > value tick && value tick > 0) || (datatype tick == BestOffer && price > value tick && value tick > 0)
then do then do
debugM "PaperBroker" $ "[1]Executing: pending limit order: " ++ show (security tick) ++ "/" ++ show (orderSecurity order) debugM "PaperBroker" $ "[1]Executing: pending limit order: " ++ show (security tick) ++ "/" ++ show (orderSecurity order)
executeAtTick state order $ tick { value = price } executeAtTick state order $ tick { value = price }
return $ Just $ orderId order return $ Just $ orderId order
else return Nothing else return Nothing
Sell -> if (datatype tick == Price && price < value tick && value tick > 0) || (datatype tick == BestBid && price < value tick && value tick > 0) Sell -> if (datatype tick == LastTradePrice && price < value tick && value tick > 0) || (datatype tick == BestBid && price < value tick && value tick > 0)
then do then do
debugM "PaperBroker" $ "[2]Executing: pending limit order: " ++ show (security tick) ++ "/" ++ show (orderSecurity order) debugM "PaperBroker" $ "[2]Executing: pending limit order: " ++ show (security tick) ++ "/" ++ show (orderSecurity order)
executeAtTick state order $ tick { value = price } executeAtTick state order $ tick { value = price }
@ -130,7 +129,7 @@ mkTrade tick order timestamp = Trade {
tradeOrderId = orderId order, tradeOrderId = orderId order,
tradePrice = value tick, tradePrice = value tick,
tradeQuantity = orderQuantity order, tradeQuantity = orderQuantity order,
tradeVolume = realFracToDecimal 10 (fromIntegral $ orderQuantity order) * value tick, tradeVolume = fromInteger (orderQuantity order) * value tick,
tradeVolumeCurrency = "TEST", tradeVolumeCurrency = "TEST",
tradeOperation = orderOperation order, tradeOperation = orderOperation order,
tradeAccount = orderAccountId order, tradeAccount = orderAccountId order,
@ -146,7 +145,7 @@ maybeCall proj state arg = do
executeAtTick state order tick = do executeAtTick state order tick = do
let newOrder = order { orderState = Executed } let newOrder = order { orderState = Executed }
let tradeVolume = realFracToDecimal 10 (fromIntegral $ orderQuantity order) * value tick let tradeVolume = fromInteger (orderQuantity order) * value tick
atomicModifyIORef' state (\s -> (s { orders = M.insert (orderId order) newOrder $ orders s , cash = cash s - tradeVolume}, ())) atomicModifyIORef' state (\s -> (s { orders = M.insert (orderId order) newOrder $ orders s , cash = cash s - tradeVolume}, ()))
debugM "PaperBroker" $ "Executed: " ++ show newOrder ++ "; at tick: " ++ show tick debugM "PaperBroker" $ "Executed: " ++ show newOrder ++ "; at tick: " ++ show tick
ts <- getCurrentTime ts <- getCurrentTime

5
src/Broker/QuikBroker.hs
Unescape View File

@ -11,7 +11,6 @@ import ATrade.Broker.Server
import Broker.QuikBroker.Trans2QuikApi hiding (tradeAccount) import Broker.QuikBroker.Trans2QuikApi hiding (tradeAccount)
import Data.Decimal
import Data.IORef import Data.IORef
import Data.List.Split import Data.List.Split
import qualified Data.List as L import qualified Data.List as L
@ -206,9 +205,9 @@ qbTradeCallback state quiktrade = do
where where
tradeFor order = Trade { tradeFor order = Trade {
tradeOrderId = orderId order, tradeOrderId = orderId order,
tradePrice = realFracToDecimal 10 $ qtPrice quiktrade, tradePrice = fromDouble $ qtPrice quiktrade,
tradeQuantity = qtQuantity quiktrade, tradeQuantity = qtQuantity quiktrade,
tradeVolume = realFracToDecimal 10 $ qtVolume quiktrade, tradeVolume = fromDouble $ qtVolume quiktrade,
tradeVolumeCurrency = T.pack $ qtVolumeCurrency quiktrade, tradeVolumeCurrency = T.pack $ qtVolumeCurrency quiktrade,
tradeOperation = if qtSell quiktrade then Sell else Buy, tradeOperation = if qtSell quiktrade then Sell else Buy,
tradeAccount = orderAccountId order, tradeAccount = orderAccountId order,

20
src/QuoteSource/PipeReader.hs
Unescape View File

@ -10,7 +10,6 @@ import Data.IORef
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import qualified Data.HashSet as HS import qualified Data.HashSet as HS
import Data.Decimal
import Data.Time.Clock import Data.Time.Clock
import Data.Time.Calendar import Data.Time.Calendar
import ATrade.Types import ATrade.Types
@ -33,8 +32,7 @@ import Data.Attoparsec.Text
import Data.Conduit import Data.Conduit
import qualified Data.Conduit.List as CL import qualified Data.Conduit.List as CL
import Data.Conduit.Attoparsec import Data.Conduit.Attoparsec
import ATrade.QuoteSource.Server
fromDouble = realFracToDecimal 10
data PipeReaderHandle = data PipeReaderHandle =
PipeReaderHandle { PipeReaderHandle {
@ -82,18 +80,18 @@ line2TickConduit = do
m <- liftIO $ readIORef volumeMap m <- liftIO $ readIORef volumeMap
case M.lookup tickerId m of case M.lookup tickerId m of
Just vol -> Just vol ->
if | vol < voltoday -> yieldTick tickerId Price ts (fromDouble last) (voltoday - vol) if | vol < voltoday -> yieldTick tickerId LastTradePrice ts (fromDouble last) (voltoday - vol)
| vol > voltoday -> yieldTick tickerId Price ts (fromDouble last) vol | vol > voltoday -> yieldTick tickerId LastTradePrice ts (fromDouble last) vol
| otherwise -> return () | otherwise -> return ()
Nothing -> yieldTick tickerId Price ts (fromDouble last) 1 Nothing -> yieldTick tickerId LastTradePrice ts (fromDouble last) 1
liftIO $ atomicModifyIORef' volumeMap (\m -> (M.insert tickerId voltoday m, ())) liftIO $ atomicModifyIORef' volumeMap (\m -> (M.insert tickerId voltoday m, ()))
AllTradeLine tickerId flags price volume ts -> do AllTradeLine tickerId flags price volume ts -> do
liftIO $ writeIORef lastTimestamp ts liftIO $ writeIORef lastTimestamp ts
if if
| flags == 1 -> yieldTick tickerId Price ts (fromDouble price) (-volume) | flags == 1 -> yieldTick tickerId LastTradePrice ts (fromDouble price) (-volume)
| flags == 2 -> yieldTick tickerId Price ts (fromDouble price) volume | flags == 2 -> yieldTick tickerId LastTradePrice ts (fromDouble price) volume
| otherwise -> return () | otherwise -> return ()
liftIO $ atomicModifyIORef' ignoreCPSet (\s -> (HS.insert tickerId s, ())) liftIO $ atomicModifyIORef' ignoreCPSet (\s -> (HS.insert tickerId s, ()))
@ -105,10 +103,10 @@ line2TickConduit = do
value = val, value = val,
volume = vol } volume = vol }
chanSink :: BoundedChan a -> Sink a IO () chanSink :: BoundedChan QuoteSourceServerData -> Sink Tick IO ()
chanSink chan = awaitForever (\t -> liftIO $ writeChan chan t) chanSink chan = awaitForever (\t -> liftIO $ writeChan chan (QSSTick t))
startPipeReader :: T.Text -> BoundedChan Tick -> IO PipeReaderHandle startPipeReader :: T.Text -> BoundedChan QuoteSourceServerData -> IO PipeReaderHandle
startPipeReader pipeName tickChan = do startPipeReader pipeName tickChan = do
f <- createFile (T.unpack pipeName) gENERIC_READ 0 Nothing oPEN_EXISTING 0 Nothing f <- createFile (T.unpack pipeName) gENERIC_READ 0 Nothing oPEN_EXISTING 0 Nothing
when (f == iNVALID_HANDLE_VALUE) $ error $ "Unable to open pipe: " ++ T.unpack pipeName when (f == iNVALID_HANDLE_VALUE) $ error $ "Unable to open pipe: " ++ T.unpack pipeName

11
src/QuoteSource/TableParsers/AllParamsTableParser.hs
Unescape View File

@ -7,10 +7,9 @@ module QuoteSource.TableParsers.AllParamsTableParser (
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import QuoteSource.TableParser import QuoteSource.TableParser
import ATrade.Types import ATrade.Types as AT
import System.Win32.XlParser import System.Win32.XlParser
import Data.Tuple import Data.Tuple
import Data.Decimal
import Control.Monad.State.Strict import Control.Monad.State.Strict
import Control.DeepSeq import Control.DeepSeq
import Data.Time.Clock import Data.Time.Clock
@ -43,7 +42,7 @@ columnCodes = M.fromList [
columnToDataType :: TableColumn -> DataType columnToDataType :: TableColumn -> DataType
columnToDataType x columnToDataType x
| x == CPrice = Price | x == CPrice = LastTradePrice
| x == CBestBid = BestBid | x == CBestBid = BestBid
| x == CBestAsk = BestOffer | x == CBestAsk = BestOffer
| x == CTotalSupply = TotalSupply | x == CTotalSupply = TotalSupply
@ -106,7 +105,7 @@ parseWithSchema sch (width, height, cells) = do
security = force $ securityName classCode ticker, security = force $ securityName classCode ticker,
datatype = columnToDataType columnType, datatype = columnToDataType columnType,
timestamp = ts, timestamp = ts,
value = force $ realFracToDecimal 10 value, value = fromDouble value,
volume = 0 } volume = 0 }
_ -> return Nothing _ -> return Nothing
@ -121,9 +120,9 @@ parseWithSchema sch (width, height, cells) = do
ts <- gets timestampHint ts <- gets timestampHint
return $ Just Tick { return $ Just Tick {
security = force $ securityName classCode ticker, security = force $ securityName classCode ticker,
datatype = Price, datatype = LastTradePrice,
timestamp = ts, timestamp = ts,
value = force $ realFracToDecimal 10 value, value = fromDouble value,
volume = tickVolume} volume = tickVolume}
else else
return Nothing return Nothing

Write Preview
Loading…
Cancel
Save