commit
cd37f6bf68
16 changed files with 1751 additions and 0 deletions
@ -0,0 +1,11 @@
@@ -0,0 +1,11 @@
|
||||
# Changelog for `transaq-connector` |
||||
|
||||
All notable changes to this project will be documented in this file. |
||||
|
||||
The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), |
||||
and this project adheres to the |
||||
[Haskell Package Versioning Policy](https://pvp.haskell.org/). |
||||
|
||||
## Unreleased |
||||
|
||||
## 0.1.0.0 - YYYY-MM-DD |
||||
@ -0,0 +1,30 @@
@@ -0,0 +1,30 @@
|
||||
Copyright Author name here (c) 2023 |
||||
|
||||
All rights reserved. |
||||
|
||||
Redistribution and use in source and binary forms, with or without |
||||
modification, are permitted provided that the following conditions are met: |
||||
|
||||
* Redistributions of source code must retain the above copyright |
||||
notice, this list of conditions and the following disclaimer. |
||||
|
||||
* Redistributions in binary form must reproduce the above |
||||
copyright notice, this list of conditions and the following |
||||
disclaimer in the documentation and/or other materials provided |
||||
with the distribution. |
||||
|
||||
* Neither the name of Author name here nor the names of other |
||||
contributors may be used to endorse or promote products derived |
||||
from this software without specific prior written permission. |
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS |
||||
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT |
||||
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR |
||||
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT |
||||
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, |
||||
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT |
||||
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, |
||||
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY |
||||
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT |
||||
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE |
||||
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |
||||
@ -0,0 +1,2 @@
@@ -0,0 +1,2 @@
|
||||
import Distribution.Simple |
||||
main = defaultMain |
||||
@ -0,0 +1,56 @@
@@ -0,0 +1,56 @@
|
||||
{-# LANGUAGE OverloadedStrings #-} |
||||
|
||||
module ATrade.Quotes.QTIS |
||||
( |
||||
TickerInfo(..), |
||||
qtisGetTickersInfo, |
||||
qtisGetTickersInfo' |
||||
) where |
||||
|
||||
import ATrade.Types |
||||
import Control.Monad |
||||
import Data.Aeson |
||||
import qualified Data.ByteString.Char8 as BC8 |
||||
import qualified Data.ByteString.Lazy as BL |
||||
import Data.Maybe |
||||
import qualified Data.Text as T |
||||
import System.ZMQ4 |
||||
|
||||
data TickerInfo = TickerInfo { |
||||
tiTicker :: T.Text, |
||||
tiLotSize :: Integer, |
||||
tiTickSize :: Price |
||||
} deriving (Show, Eq) |
||||
|
||||
instance FromJSON TickerInfo where |
||||
parseJSON = withObject "object" (\obj -> |
||||
TickerInfo <$> |
||||
obj .: "ticker" <*> |
||||
obj .: "lot_size" <*> |
||||
obj .: "tick_size") |
||||
|
||||
instance ToJSON TickerInfo where |
||||
toJSON ti = object [ "ticker" .= tiTicker ti, |
||||
"lot_size" .= tiLotSize ti, |
||||
"tick_size" .= tiTickSize ti ] |
||||
|
||||
qtisGetTickersInfo' :: T.Text -> [TickerId] -> IO [TickerInfo] |
||||
qtisGetTickersInfo' endpoint tickers = withContext (\ctx -> qtisGetTickersInfo ctx endpoint tickers) |
||||
|
||||
qtisGetTickersInfo :: Context -> T.Text -> [TickerId] -> IO [TickerInfo] |
||||
qtisGetTickersInfo ctx endpoint tickers = |
||||
withSocket ctx Req (\sock -> do |
||||
connect sock $ T.unpack endpoint |
||||
catMaybes <$> forM tickers (\tickerId -> do |
||||
send sock [] $ BL.toStrict (tickerRequest tickerId) |
||||
response <- receiveMulti sock |
||||
let r = parseResponse response |
||||
return r)) |
||||
where |
||||
tickerRequest tickerId = encode $ object ["ticker" .= tickerId] |
||||
parseResponse :: [BC8.ByteString] -> Maybe TickerInfo |
||||
parseResponse (header:payload:_) = if header == "OK" |
||||
then decode $ BL.fromStrict payload |
||||
else Nothing |
||||
parseResponse _ = Nothing |
||||
|
||||
@ -0,0 +1,41 @@
@@ -0,0 +1,41 @@
|
||||
{-# LANGUAGE DeriveGeneric #-} |
||||
|
||||
module Config |
||||
( |
||||
TransaqConnectorConfig(..), |
||||
SubscriptionConfig(..), |
||||
loadConfig, |
||||
) where |
||||
|
||||
import qualified Data.Text as T |
||||
import Dhall (FromDhall (autoWith), auto, expected, inputFile) |
||||
import GHC.Generics |
||||
|
||||
data SubscriptionConfig = SubscriptionConfig T.Text T.Text |
||||
deriving (Show, Eq, Ord, Generic) |
||||
|
||||
instance FromDhall SubscriptionConfig |
||||
|
||||
data TransaqConnectorConfig = TransaqConnectorConfig { |
||||
quotesourceEndpoint :: T.Text, |
||||
brokerEndpoint :: T.Text, |
||||
brokerNotificationsEndpoint :: T.Text, |
||||
brokerServerCertPath :: Maybe FilePath, |
||||
brokerClientCertificateDir :: Maybe FilePath, |
||||
tisEndpoint :: T.Text, |
||||
transaqLogin :: T.Text, |
||||
transaqPassword :: T.Text, |
||||
transaqHost :: T.Text, |
||||
transaqPort :: Int, |
||||
transaqLogPath :: FilePath, |
||||
transaqLogLevel :: Int, |
||||
tradesinks :: [T.Text], |
||||
allTradesSubscriptions :: [SubscriptionConfig], |
||||
quotationsSubscriptions :: [SubscriptionConfig], |
||||
quotesSubscriptions :: [SubscriptionConfig] |
||||
} deriving (Show, Eq, Generic) |
||||
|
||||
instance FromDhall TransaqConnectorConfig |
||||
|
||||
loadConfig :: FilePath -> IO TransaqConnectorConfig |
||||
loadConfig = inputFile auto |
||||
@ -0,0 +1,62 @@
@@ -0,0 +1,62 @@
|
||||
|
||||
module Main (main) where |
||||
|
||||
import ATrade (libatrade_gitrev, |
||||
libatrade_version) |
||||
import ATrade.Logging (Message (..), Severity (Info), |
||||
logWith) |
||||
import ATrade.Logging (fmtMessage) |
||||
import ATrade.QuoteSource.Server (startQuoteSourceServer, |
||||
stopQuoteSourceServer) |
||||
import ATrade.Types (defaultServerSecurityParams) |
||||
import Colog (LogAction, logTextStdout, |
||||
(>$<)) |
||||
import Colog.Actions (logTextHandle) |
||||
import Config (TransaqConnectorConfig (..), |
||||
loadConfig) |
||||
import Control.Concurrent (threadDelay) |
||||
import Control.Concurrent.BoundedChan (newBoundedChan) |
||||
import Control.Exception (bracket) |
||||
import Control.Monad (forever, void) |
||||
import Control.Monad.IO.Class (MonadIO) |
||||
import qualified Data.Text as T |
||||
import Data.Version (showVersion) |
||||
import Debug.EventCounters (initEventCounters) |
||||
import Prelude hiding (log) |
||||
import System.IO (Handle, IOMode (AppendMode), |
||||
withFile) |
||||
import System.ZMQ4 (withContext) |
||||
import TickTable (mkTickTable) |
||||
import qualified TXMLConnector as Connector |
||||
import Version (transaqConnectorVersionText) |
||||
|
||||
mkLogger :: (MonadIO m) => Handle -> LogAction m Message |
||||
mkLogger h = fmtMessage >$< (logTextStdout <> logTextHandle h) |
||||
|
||||
main :: IO () |
||||
main = do |
||||
initEventCounters |
||||
cfg <- loadConfig "transaq-connector.dhall" |
||||
withFile "transaq-connector.log" AppendMode $ \logH -> do |
||||
let logger = mkLogger logH |
||||
let log = logWith logger |
||||
log Info "main" $ "Starting transaq-connector-" <> |
||||
transaqConnectorVersionText <> |
||||
"; libatrade-" <> |
||||
(T.pack . showVersion) libatrade_version <> |
||||
"(" <> |
||||
T.pack libatrade_gitrev <> |
||||
")" |
||||
void $ withContext $ \ctx -> do |
||||
qssChannel <- newBoundedChan 50000 |
||||
bracket (startQuoteSourceServer |
||||
qssChannel |
||||
ctx |
||||
(quotesourceEndpoint cfg) |
||||
defaultServerSecurityParams) |
||||
stopQuoteSourceServer $ \_ -> do |
||||
_ <- Connector.start logger cfg qssChannel |
||||
forever $ threadDelay 1000000 |
||||
log Info "main" "Shutting down" |
||||
|
||||
|
||||
@ -0,0 +1,107 @@
@@ -0,0 +1,107 @@
|
||||
|
||||
module TXML |
||||
( |
||||
initialize |
||||
, uninitialize |
||||
, sendCommand |
||||
, setCallback |
||||
, freeCallback |
||||
, Callback |
||||
, LogLevel(..) |
||||
) where |
||||
|
||||
import qualified Data.ByteString.Char8 as BS |
||||
import qualified Data.Text as T |
||||
import Data.Text.Encoding |
||||
import Data.Text.Encoding.Error |
||||
import Foreign.C.String |
||||
import Foreign.C.Types |
||||
import Foreign.Ptr |
||||
|
||||
foreign import ccall "Initialize" c_Initialize :: CString -> CInt -> IO CString |
||||
foreign import ccall "UnInitialize" c_UnInitialize :: IO CString |
||||
foreign import ccall "SendCommand" c_SendCommand :: CString -> IO CString |
||||
foreign import ccall "SetCallback" c_SetCallback :: |
||||
FunPtr (CString -> IO CBool) -> IO CBool |
||||
foreign import ccall "FreeMemory" c_FreeMemory :: CString -> IO CBool |
||||
|
||||
{- |
||||
foreign import ccall "SetLogLevel" c_SetLogLevel :: CInt -> IO CString |
||||
foreign import ccall "SetCallbackEx" c_SetCallbackEx :: |
||||
FunPtr (CString -> CBool) -> Ptr () -> IO CBool |
||||
-} |
||||
|
||||
foreign import ccall "wrapper" createCallbackPtr :: |
||||
(CString -> IO CBool) -> IO (FunPtr (CString -> IO CBool)) |
||||
|
||||
data LogLevel = |
||||
Debug |
||||
| Info |
||||
| Warning |
||||
deriving (Show, Eq, Ord) |
||||
|
||||
newtype Callback = Callback { unCallback :: FunPtr (CString -> IO CBool)} |
||||
|
||||
logLevelToInt :: LogLevel -> CInt |
||||
logLevelToInt Debug = 3 |
||||
logLevelToInt Info = 2 |
||||
logLevelToInt Warning = 1 |
||||
|
||||
strErrorStringToResult :: CString -> IO (Either T.Text ()) |
||||
strErrorStringToResult str = |
||||
if nullPtr /= str |
||||
then do |
||||
packed <- BS.packCString str |
||||
let result = decodeUtf8With lenientDecode $ packed |
||||
_ <- c_FreeMemory str |
||||
pure $ Left result |
||||
else |
||||
pure $ Right () |
||||
|
||||
rawStringToResult :: CString -> IO (Either T.Text ()) |
||||
rawStringToResult str = |
||||
if nullPtr /= str |
||||
then do |
||||
packed <- BS.packCString str |
||||
let result = decodeUtf8With lenientDecode $ packed |
||||
_ <- c_FreeMemory str |
||||
if "<result success=\"true\"/>" `T.isPrefixOf` result |
||||
then pure $ Right () |
||||
else pure $ Left result |
||||
else |
||||
pure $ Left "" |
||||
|
||||
initialize :: FilePath -> LogLevel -> IO (Either T.Text ()) |
||||
initialize fp loglevel = |
||||
BS.useAsCString (encodeUtf8 . T.pack $ fp) $ \fpcstr -> |
||||
c_Initialize fpcstr (logLevelToInt loglevel) >>= strErrorStringToResult |
||||
|
||||
uninitialize :: IO (Either T.Text ()) |
||||
uninitialize = c_UnInitialize >>= rawStringToResult |
||||
|
||||
sendCommand :: T.Text -> IO (Either T.Text ()) |
||||
sendCommand cmdData = do |
||||
BS.useAsCString (encodeUtf8 cmdData) $ \fpcstr -> |
||||
c_SendCommand fpcstr >>= rawStringToResult |
||||
|
||||
setCallback :: (T.Text -> IO Bool) -> IO (Maybe Callback) |
||||
setCallback callback = do |
||||
wrappedCallback <- createCallbackPtr (\x -> do |
||||
packed <- BS.packCString x |
||||
boolToCBool <$> (callback $ |
||||
decodeUtf8With lenientDecode |
||||
packed)) |
||||
ret <- c_SetCallback wrappedCallback |
||||
if ret /= 0 |
||||
then return . Just . Callback $ wrappedCallback |
||||
else do |
||||
freeHaskellFunPtr wrappedCallback |
||||
return Nothing |
||||
where |
||||
boolToCBool False = 0 |
||||
boolToCBool True = 1 |
||||
|
||||
freeCallback :: Callback -> IO () |
||||
freeCallback = freeHaskellFunPtr . unCallback |
||||
|
||||
|
||||
@ -0,0 +1,308 @@
@@ -0,0 +1,308 @@
|
||||
{-# LANGUAGE DuplicateRecordFields #-} |
||||
{-# LANGUAGE OverloadedLabels #-} |
||||
{-# LANGUAGE RecordWildCards #-} |
||||
{-# LANGUAGE TypeApplications #-} |
||||
|
||||
module TXMLConnector |
||||
( |
||||
start |
||||
) where |
||||
|
||||
import ATrade.Logging (Message, Severity (..), |
||||
logWith) |
||||
import Colog (LogAction) |
||||
import Config (SubscriptionConfig (SubscriptionConfig), |
||||
TransaqConnectorConfig (..), |
||||
transaqHost, transaqLogLevel, |
||||
transaqLogPath, transaqLogin, |
||||
transaqPassword, transaqPort) |
||||
import Control.Concurrent (ThreadId, forkIO, threadDelay) |
||||
import Control.Concurrent.STM (TVar, atomically, modifyTVar', |
||||
newTVarIO, readTVarIO, |
||||
writeTVar) |
||||
import Control.Concurrent.STM.TBQueue (TBQueue, newTBQueue, |
||||
readTBQueue, writeTBQueue) |
||||
import Control.Monad (forever, void) |
||||
import Data.Maybe (mapMaybe) |
||||
import qualified Data.Text as T |
||||
import Text.XML.Light.Input (parseXML) |
||||
import Text.XML.Light.Types (Content (Elem), |
||||
Element (elName), |
||||
QName (qName)) |
||||
import Transaq (AllTradesTrade (..), |
||||
CommandConnect (..), |
||||
CommandDisconnect (CommandDisconnect), |
||||
CommandSubscribe (..), |
||||
ConnectionState (Disconnected), |
||||
Language (LanguageEn), |
||||
MarketInfo (..), |
||||
Quotation (..), |
||||
ResponseAllTrades (ResponseAllTrades), |
||||
ResponseCandleKinds (ResponseCandleKinds), |
||||
ResponseMarkets (ResponseMarkets), |
||||
ResponseQuotations (ResponseQuotations), |
||||
ResponseQuotes (ResponseQuotes), |
||||
ResponseSecurities (ResponseSecurities), |
||||
SecurityId (..), |
||||
TransaqCommand (toXml), |
||||
TransaqResponse (..), |
||||
TransaqResponse (..), |
||||
TransaqResponseC (fromXml), |
||||
state) |
||||
import TXML (LogLevel, freeCallback, |
||||
initialize, sendCommand, |
||||
setCallback) |
||||
|
||||
import ATrade.QuoteSource.Server (QuoteSourceServerData (..)) |
||||
import ATrade.Types (DataType (BestBid, BestOffer, LastTradePrice), |
||||
Tick (..), TickerId, |
||||
fromDouble) |
||||
import Control.Concurrent.BoundedChan (BoundedChan, writeChan) |
||||
import Control.Monad (forM_) |
||||
import qualified Data.Map.Strict as M |
||||
import Data.Time.Clock (UTCTime, getCurrentTime) |
||||
import qualified Transaq |
||||
import qualified TXML |
||||
|
||||
data ConnectionParams = |
||||
ConnectionParams |
||||
{ |
||||
cpLogin :: T.Text |
||||
, cpPassword :: T.Text |
||||
, cpHost :: T.Text |
||||
, cpPort :: Int |
||||
, cpLogPath :: T.Text |
||||
, cpLogLevel :: LogLevel |
||||
} |
||||
deriving (Show, Eq, Ord) |
||||
|
||||
data TXMLConnectorHandle = |
||||
TXMLConnectorHandle |
||||
{ |
||||
threadId :: ThreadId, |
||||
notificationQueue :: TBQueue TransaqResponse |
||||
} |
||||
|
||||
data ConnectionStage = StageConnection | StageGetInfo | StageConnected |
||||
deriving (Eq, Show, Ord) |
||||
|
||||
data TickKey = TickKey TickerId DataType |
||||
deriving (Show, Ord, Eq) |
||||
|
||||
start :: |
||||
LogAction IO Message |
||||
-> TransaqConnectorConfig |
||||
-> BoundedChan QuoteSourceServerData |
||||
-> IO TXMLConnectorHandle |
||||
start logger config qssChannel = do |
||||
logWith logger Info "TXMLConnector" "Starting" |
||||
notificationQueue <- atomically $ newTBQueue 50000 |
||||
tickTable <- newTVarIO M.empty |
||||
threadId <- forkIO (workThread logger config notificationQueue qssChannel tickTable) |
||||
return $ TXMLConnectorHandle {..} |
||||
|
||||
workThread :: |
||||
LogAction IO Message |
||||
-> TransaqConnectorConfig |
||||
-> TBQueue TransaqResponse |
||||
-> BoundedChan QuoteSourceServerData |
||||
-> TVar (M.Map TickKey Tick) |
||||
-> IO () |
||||
workThread logger config queue qssChannel tickMap = do |
||||
rc <- initialize (transaqLogPath config) (parseTransaqLogLevel $ transaqLogLevel config) |
||||
case rc of |
||||
Left str -> log Error "TXMLConnector.WorkThread" $ "Unable to initialize TXML" <> str |
||||
Right _ -> do |
||||
rc <- setCallback parseAndWrite |
||||
case rc of |
||||
Nothing -> log Error "TXMLConnector.WorkThread" "Unable to set callback" |
||||
Just cb -> do |
||||
serverConnected <- newTVarIO StageConnection |
||||
void $ forever $ do |
||||
connStatus <- readTVarIO serverConnected |
||||
case connStatus of |
||||
StageConnection -> handleUnconnected serverConnected |
||||
StageGetInfo -> handleGetInfo serverConnected |
||||
StageConnected -> handleConnected serverConnected |
||||
freeCallback cb |
||||
where |
||||
log = logWith logger |
||||
parseTransaqLogLevel 1 = TXML.Warning |
||||
parseTransaqLogLevel 3 = TXML.Debug |
||||
parseTransaqLogLevel _ = TXML.Info |
||||
parseAndWrite xml = do |
||||
let parsed = mapMaybe parseContent $ parseXML xml |
||||
log Debug "TXML.Callback" $ "Parsed entities: " <> (T.pack . show . length) parsed |
||||
log Debug "TXML.Callback" $ "parsed xml: " <> (T.pack . show) (parseXML xml) |
||||
log Debug "TXML.Callback" $ "parsed: " <> (T.pack . show) xml |
||||
mapM_ writeToQueue parsed |
||||
pure True |
||||
parseContent (Elem el) = parseElement el |
||||
parseContent _ = Nothing |
||||
parseElement el = case qName $ elName el of |
||||
"candles" -> TransaqResponseCandles <$> fromXml el |
||||
"server_status" -> TransaqResponseServerStatus <$> fromXml el |
||||
"markets" -> TransaqResponseMarkets <$> fromXml el |
||||
"candlekinds" -> TransaqResponseCandleKinds <$> fromXml el |
||||
"securities" -> TransaqResponseSecurities <$> fromXml el |
||||
"sec_info" -> TransaqResponseSecInfo <$> fromXml el |
||||
"quotations" -> TransaqResponseQuotations <$> fromXml el |
||||
"alltrades" -> TransaqResponseAllTrades <$> fromXml el |
||||
"quotes" -> TransaqResponseQuotes <$> fromXml el |
||||
_ -> Nothing |
||||
writeToQueue resp = atomically $ writeTBQueue queue resp |
||||
handleConnected serverConnected = do |
||||
item <- atomically $ readTBQueue queue |
||||
case item of |
||||
TransaqResponseAllTrades (ResponseAllTrades trades) -> do |
||||
let ticks = fmap allTradeToTick trades |
||||
forM_ ticks (writeChan qssChannel . QSSTick) |
||||
forM_ ticks insertToTickMap |
||||
TransaqResponseQuotations (ResponseQuotations quotations) -> do |
||||
now <- getCurrentTime |
||||
let ticks = concatMap (quotationToTicks now) quotations |
||||
forM_ ticks (writeChan qssChannel . QSSTick) |
||||
forM_ ticks insertToTickMap |
||||
_ -> pure () |
||||
handleGetInfo serverConnected = do |
||||
item <- atomically $ readTBQueue queue |
||||
case item of |
||||
TransaqResponseServerStatus serverStatus -> |
||||
case state serverStatus of |
||||
Transaq.Disconnected -> do |
||||
log Warning "TXMLConnector.WorkThread" "Server disconnected" |
||||
atomically $ writeTVar serverConnected StageConnection |
||||
Transaq.Connected -> do |
||||
log Info "TXMLConnector.WorkThread" "Server connected" |
||||
atomically $ writeTVar serverConnected StageConnected |
||||
v <- makeSubscriptions config |
||||
case v of |
||||
Left errmsg -> do |
||||
log Warning "TXMLConnector.WorkThread" $ "Unable to subscribe: " <> errmsg |
||||
void $ sendCommand $ toXml CommandDisconnect |
||||
Right _ -> log Info "TXMLConnector.WorkThread" "Subscriptions done" |
||||
Transaq.Error errmsg -> do |
||||
log Warning "TXMLConnector.WorkThread" $ "Connection error: " <> errmsg |
||||
atomically $ writeTVar serverConnected StageConnection |
||||
TransaqResponseResult result -> |
||||
log Info "TXMLConnector.WorkThread" $ "Incoming result" <> (T.pack . show) result |
||||
-- TODO: handle order response |
||||
TransaqResponseCandles candles -> |
||||
log Debug "TXMLConnector.WorkThread" $ |
||||
"Incoming candles message: " <> (T.pack . show . length . Transaq.candles $ candles) |
||||
-- TODO: Pass to qhp |
||||
TransaqResponseMarkets (ResponseMarkets markets) -> do |
||||
log Debug "TXMLConnector.WorkThread" "Incoming markets:" |
||||
forM_ markets (\m -> log Debug "TXMLConnector.WorkThread" $ (T.pack . show) (marketId m) <> "/" <> marketName m) |
||||
-- TODO: Pass to qtis |
||||
TransaqResponseCandleKinds (ResponseCandleKinds kinds) -> do |
||||
log Debug "TXMLConnector.WorkThread" "Incoming candle kinds:" |
||||
forM_ kinds (log Debug "TXMLConnector.WorkThread" . (T.pack . show)) |
||||
-- TODO: Pass to qtis, maybe something else? |
||||
TransaqResponseSecurities (ResponseSecurities securities) -> do |
||||
log Debug "TXMLConnector.WorkThread" "Incoming securities:" |
||||
forM_ securities (log Debug "TXMLConnector.WorkThread" . (T.pack . show)) |
||||
-- TODO: Pass to qtis |
||||
TransaqResponseSecInfo secInfo -> |
||||
log Debug "TXMLConnector.WorkThread" $ "Incoming secinfo:" <> (T.pack . show) secInfo |
||||
-- TODO: Pass to qtis |
||||
TransaqResponseQuotations (ResponseQuotations quotations) -> do |
||||
log Debug "TXMLConnector.WorkThread" "Incoming quotations:" |
||||
forM_ quotations (log Debug "TXMLConnector.WorkThread" . (T.pack . show)) |
||||
-- Pass to ticktable and quotesource server |
||||
TransaqResponseQuotes (ResponseQuotes quotes) -> do |
||||
log Debug "TXMLConnector.WorkThread" "Incoming quotes:" |
||||
forM_ quotes (log Debug "TXMLConnector.WorkThread" . (T.pack . show)) |
||||
-- Pass to quotesource server |
||||
_ -> pure () |
||||
handleUnconnected serverConnected = do |
||||
log Debug "TXMLConnector.WorkThread" "Sending connect command" |
||||
v <- sendCommand $ |
||||
toXml $ CommandConnect |
||||
{ |
||||
login = transaqLogin config, |
||||
password = transaqPassword config, |
||||
host = transaqHost config, |
||||
port = transaqPort config, |
||||
language = LanguageEn, |
||||
autopos = False, |
||||
micexRegisters = True, |
||||
milliseconds = True, |
||||
utcTime = True, |
||||
proxy = (), |
||||
rqDelay = Nothing, |
||||
sessionTimeout = Nothing, |
||||
requestTimeout = Nothing, |
||||
pushULimits = Nothing, |
||||
pushPosEquity = Nothing |
||||
} |
||||
case v of |
||||
Left err -> do |
||||
log Warning "TXMLConnector.WorkThread" $ "Unable to connect: [" <> err <> "]" |
||||
threadDelay (1000 * 1000 * 10) |
||||
Right _ -> do |
||||
atomically $ writeTVar serverConnected StageGetInfo |
||||
-- item <- atomically $ readTBQueue queue |
||||
-- case item of |
||||
-- TransaqResponseServerStatus status -> do |
||||
-- case state status of |
||||
-- Transaq.Error errmsg -> do |
||||
-- log Warning "TXMLConnector.WorkThread" $ "Unable to connect: " <> errmsg |
||||
-- void $ sendCommand $ toXml CommandDisconnect |
||||
-- threadDelay (10 * 1000 * 1000) |
||||
-- Transaq.Connected -> do |
||||
-- atomically $ writeTVar serverConnected StageGetInfo |
||||
-- -- v <- makeSubscriptions config |
||||
-- -- case v of |
||||
-- -- Left errmsg -> do |
||||
-- -- log Warning "TXMLConnector.WorkThread" $ "Unable to subscribe: " <> errmsg |
||||
-- -- void $ sendCommand $ toXml CommandDisconnect |
||||
-- -- Right _ -> |
||||
-- Transaq.Disconnected -> do |
||||
-- log Warning "TXMLConnector.WorkThread" "Unable to connect (disconnected)" |
||||
-- threadDelay (10 * 1000 * 1000) |
||||
-- other -> do |
||||
-- log Warning "TXMLConnector.WorkThread" $ "Stray message: " <> (T.pack . show) other |
||||
-- threadDelay (1000 * 1000) |
||||
makeSubscriptions config = |
||||
sendCommand $ toXml $ |
||||
CommandSubscribe |
||||
{ |
||||
alltrades = fmap subscriptionToSecurityId (allTradesSubscriptions config), |
||||
quotations = fmap subscriptionToSecurityId (quotationsSubscriptions config), |
||||
quotes = fmap subscriptionToSecurityId (quotesSubscriptions config) |
||||
} |
||||
subscriptionToSecurityId (SubscriptionConfig brd code) = SecurityId brd code |
||||
insertToTickMap tick = atomically $ modifyTVar' tickMap (M.insert (TickKey (security tick) (datatype tick)) tick) |
||||
|
||||
allTradeToTick :: AllTradesTrade -> Tick |
||||
allTradeToTick att = |
||||
Tick |
||||
{ |
||||
security = attBoard att <> "#" <> attSecCode att, |
||||
datatype = LastTradePrice, |
||||
timestamp = attTimestamp att, |
||||
value = fromDouble $ attPrice att, |
||||
volume = fromIntegral $ attQuantity att |
||||
} |
||||
|
||||
quotationToTicks :: UTCTime -> Quotation -> [Tick] |
||||
quotationToTicks timestamp q = |
||||
let security = qBoard q <> "#" <> qSeccode q in |
||||
[ |
||||
Tick |
||||
{ |
||||
security = security, |
||||
datatype = BestBid, |
||||
timestamp = timestamp, |
||||
value = fromDouble $ qBid q, |
||||
volume = fromIntegral $ qQuantity q |
||||
}, |
||||
Tick |
||||
{ |
||||
security = security, |
||||
datatype = BestOffer, |
||||
timestamp = timestamp, |
||||
value = fromDouble $ qOffer q, |
||||
volume = fromIntegral $ qQuantity q |
||||
}] |
||||
@ -0,0 +1,46 @@
@@ -0,0 +1,46 @@
|
||||
|
||||
module TickTable ( |
||||
mkTickTable, |
||||
TickKey(..), |
||||
getTick, |
||||
TickTableH |
||||
) where |
||||
|
||||
import ATrade.Types (DataType (..), Tick (..), |
||||
TickerId (..)) |
||||
import Control.Concurrent (forkIO) |
||||
import Control.Concurrent.BoundedChan (BoundedChan, readChan) |
||||
import Control.Concurrent.MVar (newEmptyMVar) |
||||
import Control.Concurrent.MVar (readMVar) |
||||
import Control.Concurrent.STM (TVar, atomically, modifyTVar', |
||||
newTVarIO, readTVarIO) |
||||
import Control.Monad (forever, void) |
||||
import Control.Monad.Extra (whileM) |
||||
import Data.IORef (readIORef) |
||||
import qualified Data.Map.Strict as M |
||||
import qualified Data.Text as T |
||||
import System.ZMQ4 (Context) |
||||
|
||||
data TickKey = TickKey TickerId DataType |
||||
deriving (Show, Ord, Eq) |
||||
|
||||
data TickTable = TickTable { |
||||
ticks :: !(M.Map TickKey Tick) |
||||
} |
||||
type TickTableH = TVar TickTable |
||||
|
||||
mkTickTable :: BoundedChan Tick -> IO (TVar TickTable) |
||||
mkTickTable chan = do |
||||
shutdownMVar <- newEmptyMVar |
||||
r <- newTVarIO TickTable { ticks = M.empty } |
||||
void $ forkIO $ tickTableThread r shutdownMVar |
||||
return r |
||||
where |
||||
tickTableThread r shutdownMVar = whileM $ do |
||||
t <- readChan chan |
||||
atomically $ modifyTVar' r (\s -> s { ticks = M.insert (TickKey (security t) (datatype t)) t $! ticks s }) |
||||
readMVar shutdownMVar |
||||
|
||||
getTick :: TickTableH -> TickKey -> IO (Maybe Tick) |
||||
getTick r key = M.lookup key . ticks <$> readTVarIO r |
||||
|
||||
@ -0,0 +1,880 @@
@@ -0,0 +1,880 @@
|
||||
{-# LANGUAGE DuplicateRecordFields #-} |
||||
{-# LANGUAGE RecordWildCards #-} |
||||
|
||||
module Transaq |
||||
( |
||||
CommandConnect(..), |
||||
Language(..), |
||||
TransaqCommand(..), |
||||
TransaqResponseC(..), |
||||
TransaqResponse(..), |
||||
SecurityId(..), |
||||
CommandDisconnect(..), |
||||
CommandSubscribe(..), |
||||
CommandNewOrder(..), |
||||
CommandCancelOrder(..), |
||||
CommandGetSecuritiesInfo(..), |
||||
ResponseResult(..), |
||||
ResponseCandles(..), |
||||
ResponseServerStatus(..), |
||||
ResponseCandleKinds(..), |
||||
ResponseMarkets(..), |
||||
ResponseSecurities(..), |
||||
ResponseSecInfo(..), |
||||
ResponseQuotations(..), |
||||
ResponseAllTrades(..), |
||||
ResponseTrades(..), |
||||
ResponseQuotes(..), |
||||
Quotation(..), |
||||
Quote(..), |
||||
TradeNotification(..), |
||||
OrderNotification(..), |
||||
AllTradesTrade(..), |
||||
Tick(..), |
||||
ConnectionState(..), |
||||
MarketInfo(..) |
||||
) where |
||||
|
||||
import Control.Applicative ((<|>)) |
||||
import Control.Error.Util (hush) |
||||
import Control.Monad (void) |
||||
import Data.Attoparsec.Text (Parser, char, decimal, many', |
||||
maybeResult, parse, parseOnly, |
||||
skipSpace) |
||||
import Data.Decimal (DecimalRaw (..)) |
||||
import Data.Int (Int64) |
||||
import Data.Maybe (catMaybes, fromMaybe, mapMaybe, |
||||
maybeToList) |
||||
import qualified Data.Text as T |
||||
import Data.Time (fromGregorian) |
||||
import Data.Time.Clock (UTCTime (UTCTime)) |
||||
import Debug.Trace |
||||
import Text.Read (readMaybe) |
||||
import Text.XML.Light (Attr (..), CData (cdData), |
||||
Element (elName), Node (..), QName (..), |
||||
elChildren, findAttr, findChild, |
||||
onlyText, strContent, unode) |
||||
import Text.XML.Light.Output (showElement) |
||||
import Text.XML.Light.Types (Element (elContent), blank_name) |
||||
|
||||
data Language = LanguageRu | LanguageEn |
||||
deriving (Show, Eq, Ord) |
||||
|
||||
instance Node Language where |
||||
node n LanguageRu = node n ("ru" :: String) |
||||
node n LanguageEn = node n ("en" :: String) |
||||
|
||||
type TransaqPrice = DecimalRaw Int |
||||
|
||||
strAttr :: String -> String -> Attr |
||||
strAttr key val = Attr { attrKey = blank_name { qName = key}, attrVal = val} |
||||
|
||||
fromBool :: Bool -> String |
||||
fromBool True = "true" |
||||
fromBool False = "false" |
||||
|
||||
parseTimestamp :: T.Text -> Maybe UTCTime |
||||
parseTimestamp = hush . parseOnly parser |
||||
where |
||||
parser = parseWithDate <|> (UTCTime epoch <$> parseTime) |
||||
parseWithDate = do |
||||
date <- parseDate |
||||
skipSpace |
||||
time <- parseTime |
||||
pure $ UTCTime date time |
||||
parseDate = do |
||||
day <- decimal |
||||
void $ char '.' |
||||
month <- decimal |
||||
void $ char '.' |
||||
year <- decimal |
||||
pure $ fromGregorian year month day |
||||
|
||||
parseTime = do |
||||
hour <- (decimal :: Parser Int) |
||||
void $ char ':' |
||||
minute <- decimal |
||||
void $ char ':' |
||||
second <- decimal |
||||
msecs <- many' $ do |
||||
void $ char '.' |
||||
(decimal :: Parser Int) |
||||
let secofday = hour * 3600 + minute * 60 + second |
||||
case msecs of |
||||
[ms] -> pure $ fromIntegral secofday + fromIntegral ms / 1000.0 |
||||
_ -> pure $ fromIntegral secofday |
||||
epoch = fromGregorian 1970 1 1 |
||||
|
||||
|
||||
class TransaqCommand t where |
||||
toXml :: t -> T.Text |
||||
|
||||
class TransaqResponseC t where |
||||
fromXml :: Element -> Maybe t |
||||
|
||||
data CommandConnect = |
||||
CommandConnect |
||||
{ |
||||
login :: T.Text, |
||||
password :: T.Text, |
||||
host :: T.Text, |
||||
port :: Int, |
||||
language :: Language, |
||||
autopos :: Bool, |
||||
micexRegisters :: Bool, |
||||
milliseconds :: Bool, |
||||
utcTime :: Bool, |
||||
proxy :: (), -- not supported |
||||
rqDelay :: Maybe Int, |
||||
sessionTimeout :: Maybe Int, |
||||
requestTimeout :: Maybe Int, |
||||
pushULimits :: Maybe Int, |
||||
pushPosEquity :: Maybe Int |
||||
} deriving (Show, Eq, Ord) |
||||
|
||||
instance Node CommandConnect where |
||||
node n CommandConnect {..} = node n (attrs, subnodes) |
||||
where |
||||
attrs = [strAttr "id" "connect"] |
||||
subnodes = |
||||
[ unode "login" (T.unpack login) |
||||
, unode "password" (T.unpack password) |
||||
, unode "host" (T.unpack host) |
||||
, unode "port" (show port) |
||||
, unode "language" language |
||||
, unode "autopos" (fromBool autopos) |
||||
, unode "micex_registers" (fromBool micexRegisters) |
||||
, unode "milliseconds" (fromBool milliseconds) |
||||
, unode "utc_time" (fromBool utcTime) |
||||
] |
||||
++ maybeToList (unode "rqdelay" . show <$> rqDelay) |
||||
++ maybeToList (unode "session_timeout" . show <$> sessionTimeout) |
||||
++ maybeToList (unode "request_timeout" . show <$> requestTimeout) |
||||
++ maybeToList (unode "push_u_limits" . show <$> pushULimits) |
||||
++ maybeToList (unode "push_pos_limits" . show <$> pushPosEquity) |
||||
|
||||
instance TransaqCommand CommandConnect where |
||||
toXml = T.pack . showElement . unode "command" |
||||
|
||||
data CommandDisconnect = CommandDisconnect |
||||
deriving (Show, Eq, Ord) |
||||
|
||||
instance TransaqCommand CommandDisconnect where |
||||
toXml CommandDisconnect = T.pack . showElement $ unode "command" [strAttr "id" "disconnect"] |
||||
|
||||
data SecurityId = |
||||
SecurityId |
||||
{ |
||||
board :: T.Text |
||||
, seccode :: T.Text |
||||
} deriving (Show, Eq, Ord) |
||||
|
||||
instance Node SecurityId where |
||||
node n SecurityId {..} = node n |
||||
[ unode "board" (T.unpack board) |
||||
, unode "seccode" (T.unpack seccode) |
||||
] |
||||
|
||||
data CommandSubscribe = |
||||
CommandSubscribe |
||||
{ |
||||
alltrades :: [SecurityId] |
||||
, quotations :: [SecurityId] |
||||
, quotes :: [SecurityId] |
||||
} deriving (Show, Eq, Ord) |
||||
|
||||
instance TransaqCommand CommandSubscribe where |
||||
toXml CommandSubscribe {..} = |
||||
T.pack . showElement $ unode "command" ([strAttr "id" "subscribe"], |
||||
[ unode "alltrades" $ fmap (unode "security") alltrades |
||||
, unode "quotations" $ fmap (unode "security") quotations |
||||
, unode "quotes" $ fmap (unode "security") quotes |
||||
]) |
||||
|
||||
data CommandUnsubscribe = |
||||
CommandUnsubscribe |
||||
{ |
||||
alltrades :: [SecurityId] |
||||
, quotations :: [SecurityId] |
||||
, quotes :: [SecurityId] |
||||
} deriving (Show, Eq, Ord) |
||||
|
||||
instance TransaqCommand CommandUnsubscribe where |
||||
toXml CommandUnsubscribe {..} = |
||||
T.pack . showElement $ unode "command" ([strAttr "id" "unsubscribe"], |
||||
[ unode "alltrades" $ fmap (unode "security") alltrades |
||||
, unode "quotations" $ fmap (unode "security") quotations |
||||
, unode "quotes" $ fmap (unode "security") quotes |
||||
]) |
||||
|
||||
data CommandGetHistoryData = |
||||
CommandGetHistoryData |
||||
{ |
||||
security :: SecurityId |
||||
, periodId :: Int |
||||
, count :: Int |
||||
, reset :: Bool |
||||
} deriving (Show, Eq, Ord) |
||||
|
||||
instance TransaqCommand CommandGetHistoryData where |
||||
toXml CommandGetHistoryData {..} = |
||||
T.pack . showElement $ unode "command" ([strAttr "id" "gethistorydata"], |
||||
[ unode "security" security |
||||
, unode "period" (show periodId) |
||||
, unode "count" (show count) |
||||
, unode "reset" (fromBool reset) |
||||
]) |
||||
|
||||
data TradeDirection = Buy | Sell |
||||
deriving (Show, Eq, Ord) |
||||
|
||||
instance Node TradeDirection where |
||||
node n Buy = node n ("B" :: String) |
||||
node n Sell = node n ("S" :: String) |
||||
|
||||
data UnfilledAction = |
||||
UnfilledPutInQueue |
||||
| UnfilledFOK |
||||
| UnfilledIOC |
||||
deriving (Show, Eq, Ord) |
||||
|
||||
instance Node UnfilledAction where |
||||
node n UnfilledPutInQueue = node n ("PutInQueue" :: String) |
||||
node n UnfilledFOK = node n ("FOK" :: String) |
||||
node n UnfilledIOC = node n ("IOC" :: String) |
||||
|
||||
data CommandNewOrder = |
||||
CommandNewOrder |
||||
{ |
||||
security :: SecurityId |
||||
, client :: T.Text |
||||
, unionCode :: T.Text |
||||
, price :: TransaqPrice |
||||
, quantity :: Int |
||||
, buysell :: TradeDirection |
||||
, bymarket :: Bool |
||||
, brokerRef :: T.Text |
||||
, unfilled :: UnfilledAction |
||||
, usecredit :: Bool |
||||
, nosplit :: Bool |
||||
} deriving (Show, Eq, Ord) |
||||
|
||||
instance TransaqCommand CommandNewOrder where |
||||
toXml CommandNewOrder {..} = |
||||
T.pack . showElement $ unode "command" ([strAttr "id" "neworder"], |
||||
[ unode "security" security |
||||
, unode "client" $ T.unpack client |
||||
, unode "union" $ T.unpack unionCode |
||||
, unode "price" $ show price |
||||
, unode "quantity" $ show quantity |
||||
, unode "buysell" buysell |
||||
, unode "brokerref" $ T.unpack brokerRef |
||||
, unode "unfillled" unfilled |
||||
] |
||||
++ boolToList "bymarket" bymarket |
||||
++ boolToList "usecredit" usecredit |
||||
++ boolToList "nosplit" nosplit) |
||||
where |
||||
boolToList n True = [unode n ("" :: String)] |
||||
boolToList _ False = [] |
||||
|
||||
newtype CommandCancelOrder = |
||||
CommandCancelOrder |
||||
{ |
||||
transactionId :: Integer |
||||
} deriving (Show, Eq, Ord) |
||||
|
||||
instance TransaqCommand CommandCancelOrder where |
||||
toXml CommandCancelOrder{..} = |
||||
T.pack . showElement $ unode "command" ([strAttr "id" "cancelOrder"], |
||||
[ unode "transactionid" (show transactionId)]) |
||||
|
||||
newtype CommandGetSecuritiesInfo = |
||||
CommandGetSecuritiesInfo |
||||
{ |
||||
securities :: [SecurityId] |
||||
} deriving (Show, Eq, Ord) |
||||
|
||||
instance TransaqCommand CommandGetSecuritiesInfo where |
||||
toXml CommandGetSecuritiesInfo{..} = |
||||
T.pack . showElement $ unode "command" ([strAttr "id" "get_securities_info"], |
||||
fmap (unode "security") securities) |
||||
|
||||
data ResponseResult = |
||||
ResponseSuccess |
||||
| ResponseFailure T.Text |
||||
deriving (Show, Eq, Ord) |
||||
|
||||
instance TransaqResponseC ResponseResult where |
||||
fromXml root = |
||||
if qName (elName root) == "result" |
||||
then |
||||
if findAttr (blank_name {qName = "success"}) root == Just "true" |
||||
then Just ResponseSuccess |
||||
else Just . ResponseFailure . T.pack . concatMap cdData . onlyText . elContent $ root |
||||
else Nothing |
||||
|
||||
|
||||
data Candle = |
||||
Candle |
||||
{ |
||||
cTimestamp :: UTCTime |
||||
, cOpen :: TransaqPrice |
||||
, cHigh :: TransaqPrice |
||||
, cLow :: TransaqPrice |
||||
, cClose :: TransaqPrice |
||||
, cVolume :: Int |
||||
, cOpenInterest :: Int |
||||
} deriving (Show, Eq, Ord) |
||||
|
||||
data ResponseCandlesStatus = |
||||
StatusEndOfHistory |
||||
| StatusDone |
||||
| StatusPending |
||||
| StatusUnavaliable |
||||
deriving (Show, Eq, Ord) |
||||
|
||||
data ResponseCandles = |
||||
ResponseCandles |
||||
{ |
||||
periodId :: Int |
||||
, status :: ResponseCandlesStatus |
||||
, security :: SecurityId |
||||
, candles :: [Candle] |
||||
} deriving (Show, Eq, Ord) |
||||
|
||||
uname :: String -> QName |
||||
uname x = blank_name {qName = x} |
||||
|
||||
childContent :: String -> Element -> Maybe String |
||||
childContent tag el = strContent <$> findChild (uname tag) el |
||||
|
||||
instance TransaqResponseC ResponseCandles where |
||||
fromXml root = do |
||||
periodId <- findAttr (uname "period") root >>= readMaybe |
||||
status <- findAttr (uname "status") root >>= readMaybe >>= parseStatus |
||||
board <- T.pack <$> findAttr (uname "board") root |
||||
seccode <- T.pack <$> findAttr (uname "seccode") root |
||||
let candles = mapMaybe parseCandle . elChildren $ root |
||||
return ResponseCandles |
||||
{ |
||||
periodId = periodId |
||||
, status = status |
||||
, security = SecurityId board seccode |
||||
, candles = candles |
||||
} |
||||
where |
||||
parseStatus :: Int -> Maybe ResponseCandlesStatus |
||||
parseStatus intStatus = |
||||
case intStatus of |
||||
0 -> Just StatusEndOfHistory |
||||
1 -> Just StatusDone |
||||
2 -> Just StatusPending |
||||
3 -> Just StatusUnavaliable |
||||
_ -> Nothing |
||||
parseCandle element = do |
||||
timestamp <- findAttr (uname "open") element >>= parseTimestamp . T.pack |
||||
open <- findAttr (uname "open") element >>= readMaybe |
||||
high <- findAttr (uname "high") element >>= readMaybe |
||||
low <- findAttr (uname "low") element >>= readMaybe |
||||
close <- findAttr (uname "close") element >>= readMaybe |
||||
volume <- findAttr (uname "volume") element >>= readMaybe |
||||
openInterest <- findAttr (uname "oi") element >>= readMaybe |
||||
return Candle |
||||
{ |
||||
cTimestamp = timestamp |
||||
, cOpen = open |
||||
, cHigh = high |
||||
, cLow = low |
||||
, cClose = close |
||||
, cVolume = volume |
||||
, cOpenInterest = openInterest |
||||
} |
||||
|
||||
data ConnectionState = |
||||
Connected |
||||
| Disconnected |
||||
| Error T.Text |
||||
deriving (Show, Eq, Ord) |
||||
|
||||
data ResponseServerStatus = |
||||
ResponseServerStatus |
||||
{ |
||||
serverId :: Maybe Int |
||||
, state :: ConnectionState |
||||
, recover :: Maybe Bool |
||||
, serverTimezone :: Maybe T.Text |
||||
, systemVersion :: Maybe Int |
||||
, build :: Maybe Int |
||||
} deriving (Show, Eq, Ord) |
||||
|
||||
instance TransaqResponseC ResponseServerStatus where |
||||
fromXml root = do |
||||
let serverId = findAttr (uname "id") root >>= readMaybe |
||||
connectedStr <- findAttr (uname "connected") root |
||||
state <- case connectedStr of |
||||
"true" -> pure Connected |
||||
"false" -> pure Disconnected |
||||
"error" -> pure $ Error (T.pack $ strContent root) |
||||
_ -> pure Disconnected |
||||
let recover = |
||||
case findAttr (uname "recover") root of |
||||
Just "true" -> pure True |
||||
_ -> pure False |
||||
let serverTimezone = T.pack <$> findAttr (uname "server_tz") root |
||||
let systemVersion = findAttr (uname "sys_ver") root >>= readMaybe |
||||
let build = findAttr (uname "build") root >>= readMaybe |
||||
pure $ ResponseServerStatus {..} |
||||
|
||||
data MarketInfo = |
||||
MarketInfo |
||||
{ marketId :: Int |
||||
, marketName :: T.Text |
||||
} deriving (Show, Eq, Ord) |
||||
|
||||
newtype ResponseMarkets = ResponseMarkets [MarketInfo] |
||||
deriving (Show, Eq, Ord) |
||||
|
||||
instance TransaqResponseC ResponseMarkets where |
||||
fromXml root = do |
||||
markets <- mapM parseMarketInfo $ elChildren root |
||||
pure . ResponseMarkets . catMaybes $ markets |
||||
where |
||||
parseMarketInfo tag = |
||||
if (qName . elName) tag == "market" |
||||
then do |
||||
marketId <- findAttr (uname "id") tag >>= readMaybe |
||||
let marketName = T.pack $ strContent tag |
||||
pure $ Just $ MarketInfo {..} |
||||
else pure Nothing |
||||
|
||||
data CandleKind = |
||||
CandleKind |
||||
{ |
||||
kCandleKindId :: Int |
||||
, kPeriod :: Int |
||||
, kName :: T.Text |
||||
} deriving (Show, Eq, Ord) |
||||
|
||||
newtype ResponseCandleKinds = ResponseCandleKinds [CandleKind] |
||||
deriving (Show, Eq, Ord) |
||||
|
||||
|
||||
instance TransaqResponseC ResponseCandleKinds where |
||||
fromXml root = do |
||||
kinds <- mapM parseCandleKind $ elChildren root |
||||
pure . ResponseCandleKinds . catMaybes $ kinds |
||||
where |
||||
parseCandleKind tag = |
||||
if (qName . elName) tag == "kind" |
||||
then do |
||||
kCandleKindId <- childContent "id" tag >>= readMaybe |
||||
kPeriod <- childContent "period" tag >>= readMaybe |
||||
kName <- T.pack <$> childContent "name" tag |
||||
pure . Just $ CandleKind {..} |
||||
else pure Nothing |
||||
|
||||
data Security = |
||||
Security |
||||
{ |
||||
secId :: Int |
||||
, active :: Bool |
||||
, seccode :: T.Text |
||||
, instrClass :: T.Text |
||||
, board :: T.Text |
||||
, market :: T.Text |
||||
, currency :: T.Text |
||||
, shortName :: T.Text |
||||
, decimals :: Int |
||||
, minStep :: Double |
||||
, lotSize :: Int |
||||
, lotDivider :: Int |
||||
, pointCost :: Double |
||||
, secType :: T.Text |
||||
} deriving (Show, Eq, Ord) |
||||
|
||||
newtype ResponseSecurities = |
||||
ResponseSecurities [Security] |
||||
deriving (Show, Eq, Ord) |
||||
|
||||
instance TransaqResponseC ResponseSecurities where |
||||
fromXml root = do |
||||
securities <- mapM parseSecurity $ elChildren root |
||||
pure . ResponseSecurities . catMaybes $ securities |
||||
where |
||||
parseSecurity tag = |
||||
if (qName . elName) tag == "security" |
||||
then do |
||||
secId <- findAttr (uname "secid") tag >>= readMaybe |
||||
active <- findAttr (uname "active") tag >>= parseBool |
||||
seccode <- T.pack <$> childContent "seccode" tag |
||||
instrClass <- T.pack <$> childContent "instrclass" tag |
||||
board <- T.pack <$> childContent "instrclass" tag |
||||
market <- T.pack <$> childContent "market" tag |
||||
currency <- T.pack <$> childContent "currency" tag |
||||
shortName <- T.pack <$> childContent "shortname" tag |
||||
decimals <- childContent "decimals" tag >>= readMaybe |
||||
minStep <- childContent "minstep" tag >>= readMaybe |
||||
lotSize <- childContent "lotsize" tag >>= readMaybe |
||||
lotDivider <- childContent "lotdivider" tag >>= readMaybe |
||||
pointCost <- childContent "point_cost" tag >>= readMaybe |
||||
secType <- T.pack <$> childContent "sectype" tag |
||||
pure . Just $ Security {..} |
||||
else |
||||
pure Nothing |
||||
|
||||
parseBool "true" = Just True |
||||
parseBool "false" = Just False |
||||
parseBool _ = Nothing |
||||
|
||||
|
||||
data ResponseSecInfo = |
||||
ResponseSecInfo |
||||
{ |
||||
secId :: Int |
||||
, secName :: T.Text |
||||
, secCode :: T.Text |
||||
, market :: Int |
||||
, pname :: T.Text |
||||
, clearingPrice :: Double |
||||
, minprice :: Double |
||||
, maxprice :: Double |
||||
, pointCost :: Double |
||||
} deriving (Show, Eq, Ord) |
||||
|
||||
|
||||
instance TransaqResponseC ResponseSecInfo where |
||||
fromXml tag = do |
||||
secId <- findAttr (uname "secid") tag >>= readMaybe |
||||
secName <- T.pack <$> childContent "secname" tag |
||||
secCode <- T.pack <$> childContent "seccode" tag |
||||
market <- childContent "market" tag >>= readMaybe |
||||
pname <- T.pack <$> childContent "pname" tag |
||||
clearingPrice <- childContent "clearing_price" tag >>= readMaybe |
||||
minprice <- childContent "minprice" tag >>= readMaybe |
||||
maxprice <- childContent "maxprice" tag >>= readMaybe |
||||
pointCost <- childContent "point_cost" tag >>= readMaybe |
||||
pure ResponseSecInfo {..} |
||||
|
||||
data Quotation = |
||||
Quotation |
||||
{ |
||||
qSecId :: Int |
||||
, qBoard :: T.Text |
||||
, qSeccode :: T.Text |
||||
, qOpen :: Double |
||||
, qWaprice :: Double |
||||
, qBidDepth :: Int |
||||
, qBidDepthT :: Int |
||||
, qNumBids :: Int |
||||
, qOfferDepth :: Int |
||||
, qOfferDepthT :: Int |
||||
, qBid :: Double |
||||
, qOffer :: Double |
||||
, qNumOffers :: Int |
||||
, qNumTrades :: Int |
||||
, qVolToday :: Int |
||||
, qOpenPositions :: Int |
||||
, qLastPrice :: Double |
||||
, qQuantity :: Int |
||||
, qTimestamp :: UTCTime |
||||
, qValToday :: Double |
||||
} deriving (Show, Eq, Ord) |
||||
|
||||
newtype ResponseQuotations = |
||||
ResponseQuotations [Quotation] |
||||
deriving (Show, Eq, Ord) |
||||
|
||||
instance TransaqResponseC ResponseQuotations where |
||||
fromXml root = do |
||||
quotations <- mapM parseQuotation $ elChildren root |
||||
pure . ResponseQuotations . catMaybes $ quotations |
||||
where |
||||
parseQuotation tag = do |
||||
qSecId <- findAttr (uname "secid") tag >>= readMaybe |
||||
qBoard <- T.pack <$> childContent "board" tag |
||||
qSeccode <- T.pack <$> childContent "seccode" tag |
||||
qOpen <- childContent "open" tag >>= readMaybe |
||||
qWaprice <- childContent "waprice" tag >>= readMaybe |
||||
qBidDepth <- childContent "biddepth" tag >>= readMaybe |
||||
qBidDepthT <- childContent "biddeptht" tag >>= readMaybe |
||||
qNumBids <- childContent "numbids" tag >>= readMaybe |
||||
qBid <- childContent "bid" tag >>= readMaybe |
||||
qOfferDepth <- childContent "offerdepth" tag >>= readMaybe |
||||
qOfferDepthT <- childContent "offerdeptht" tag >>= readMaybe |
||||
qNumOffers <- childContent "numoffers" tag >>= readMaybe |
||||
qOffer <- childContent "offer" tag >>= readMaybe |
||||
qNumTrades <- childContent "numtrades" tag >>= readMaybe |
||||
qVolToday <- childContent "voltoday" tag >>= readMaybe |
||||
qOpenPositions <- childContent "openpositions" tag >>= readMaybe |
||||
qLastPrice <- childContent "last" tag >>= readMaybe |
||||
qQuantity <- childContent "quantity" tag >>= readMaybe |
||||
qTimestamp <- childContent "time" tag >>= (parseTimestamp . T.pack) |
||||
qValToday <- childContent "valToday" tag >>= readMaybe |
||||
pure $ Just Quotation {..} |
||||
|
||||
data TradingPeriod = |
||||
PeriodOpen |
||||
| PeriodNormal |
||||
| PeriodClose |
||||
| PeriodUnknown |
||||
deriving (Show, Eq, Ord) |
||||
|
||||
data AllTradesTrade = |
||||
AllTradesTrade |
||||
{ |
||||
attSecId :: Int |
||||
, attSecCode :: T.Text |
||||
, attTradeNo :: Int64 |
||||
, attTimestamp :: UTCTime |
||||
, attBoard :: T.Text |
||||
, attPrice :: Double |
||||
, attQuantity :: Int |
||||
, attBuysell :: TradeDirection |
||||
, attOpenInterest :: Int |
||||
, attPeriod :: TradingPeriod |
||||
} deriving (Show, Eq, Ord) |
||||
|
||||
newtype ResponseAllTrades = |
||||
ResponseAllTrades [AllTradesTrade] |
||||
deriving (Show, Eq, Ord) |
||||
|
||||
parseTradeDirection :: T.Text -> Maybe TradeDirection |
||||
parseTradeDirection t = |
||||
case t of |
||||
"B" -> Just Buy |
||||
"S" -> Just Sell |
||||
_ -> Nothing |
||||
|
||||
instance TransaqResponseC ResponseAllTrades where |
||||
fromXml root = do |
||||
alltrades <- mapM parseAllTrade $ elChildren root |
||||
pure . ResponseAllTrades . catMaybes $ alltrades |
||||
where |
||||
parseAllTrade tag = do |
||||
attSecId <- findAttr (uname "secid") tag >>= readMaybe |
||||
attSecCode <- T.pack <$> childContent "seccode" tag |
||||
attTradeNo <- childContent "tradeno" tag >>= readMaybe |
||||
attTimestamp <- T.pack <$> childContent "time" tag >>= parseTimestamp |
||||
attBoard <- T.pack <$> childContent "board" tag |
||||
attPrice <- childContent "price" tag >>= readMaybe |
||||
attQuantity <- childContent "quantity" tag >>= readMaybe |
||||
attBuysell <- T.pack <$> childContent "buysell" tag >>= parseTradeDirection |
||||
let attOpenInterest = fromMaybe 0 $ childContent "openinterest" tag >>= readMaybe |
||||
let attPeriod = fromMaybe PeriodUnknown $ childContent "period" tag >>= parseTradingPeriod |
||||
pure . Just $ AllTradesTrade {..} |
||||
|
||||
parseTradingPeriod :: String -> Maybe TradingPeriod |
||||
parseTradingPeriod "O" = Just PeriodOpen |
||||
parseTradingPeriod "N" = Just PeriodNormal |
||||
parseTradingPeriod "C" = Just PeriodClose |
||||
parseTradingPeriod _ = Nothing |
||||
|
||||
|
||||
data Quote = |
||||
Quote |
||||
{ |
||||
secId :: Int |
||||
, board :: T.Text |
||||
, secCode :: T.Text |
||||
, price :: Double |
||||
, source :: T.Text |
||||
, yield :: Int |
||||
, buy :: Int |
||||
, sell :: Int |
||||
} deriving (Show, Eq, Ord) |
||||
|
||||
newtype ResponseQuotes = |
||||
ResponseQuotes [Quote] |
||||
deriving (Show, Eq, Ord) |
||||
|
||||
instance TransaqResponseC ResponseQuotes where |
||||
fromXml root = do |
||||
quotes <- mapM parseQuote $ elChildren root |
||||
pure . ResponseQuotes . catMaybes $ quotes |
||||
where |
||||
parseQuote tag = do |
||||
secId <- findAttr (uname "secid") tag >>= readMaybe |
||||
secCode <- T.pack <$> childContent "seccode" tag |
||||
board <- T.pack <$> childContent "board" tag |
||||
price <- childContent "price" tag >>= readMaybe |
||||
source <- T.pack <$> childContent "source" tag |
||||
yield <- childContent "yield" tag >>= readMaybe |
||||
buy <- childContent "buy" tag >>= readMaybe |
||||
sell <- childContent "sell" tag >>= readMaybe |
||||
return . Just $ Quote {..} |
||||
|
||||
data OrderStatus = |
||||
OrderCancelled |
||||
| OrderDenied |
||||
| OrderDisabled |
||||
| OrderExpired |
||||
| OrderFailed |
||||
| OrderLinkWait |
||||
| OrderRejected |
||||
| OrderSLExecuted |
||||
| OrderSLForwarding |
||||
| OrderSLGuardTime |
||||
| OrderTPCorrection |
||||
| OrderTPCorrectionGuardTime |
||||
| OrderTPExecuted |
||||
| OrderTPForwarding |
||||
| OrderTPGuardTime |
||||
| OrderWatching |
||||
deriving (Show, Eq, Ord) |
||||
|
||||
data OrderNotification = |
||||
OrderNotification |
||||
{ |
||||
transactionId :: Int |
||||
, orderNo :: Int64 |
||||
, secId :: Int |
||||
, board :: T.Text |
||||
, secCode :: T.Text |
||||
, client :: T.Text |
||||
, union :: T.Text |
||||
, status :: OrderStatus |
||||
, buysell :: TradeDirection |
||||
, timestamp :: UTCTime |
||||
, brokerRef :: T.Text |
||||
, balance :: Int |
||||
, price :: Double |
||||
, quantity :: Int |
||||
, result :: T.Text |
||||
} deriving (Show, Eq, Ord) |
||||
|
||||
newtype ResponseOrders = |
||||
ResponseOrders [OrderNotification] |
||||
deriving (Show, Eq, Ord) |
||||
|
||||
instance TransaqResponseC ResponseOrders where |
||||
fromXml root = do |
||||
quotes <- mapM parseOrder $ elChildren root |
||||
pure . ResponseOrders . catMaybes $ quotes |
||||
where |
||||
parseOrder tag = do |
||||
transactionId <- findAttr (uname "transactionid") tag >>= readMaybe |
||||
orderNo <- childContent "orderno" tag >>= readMaybe |
||||
secId <- childContent "secid" tag >>= readMaybe |
||||
board <- T.pack <$> childContent "board" tag |
||||
secCode <- T.pack <$> childContent "seccode" tag |
||||
client <- T.pack <$> childContent "client" tag |
||||
union <- T.pack <$> childContent "union" tag |
||||
status <- childContent "status" tag >>= parseStatus |
||||
buysell <- childContent "buysell" tag >>= parseTradeDirection . T.pack |
||||
timestamp <- childContent "time" tag >>= parseTimestamp . T.pack |
||||
brokerRef <- T.pack <$> childContent "brokerref" tag |
||||
balance <- childContent "balance" tag >>= readMaybe |
||||
price <- childContent "price" tag >>= readMaybe |
||||
quantity <- childContent "quantity" tag >>= readMaybe |
||||
result <- T.pack <$> childContent "result" tag |
||||
return . Just $ OrderNotification {..} |
||||
parseStatus "cancelled" = Just OrderCancelled |
||||
parseStatus "denied" = Just OrderDenied |
||||
parseStatus "disabled" = Just OrderDisabled |
||||
parseStatus "expired" = Just OrderExpired |
||||
parseStatus "failed" = Just OrderFailed |
||||
parseStatus "linkwait" = Just OrderLinkWait |
||||
parseStatus "rejected" = Just OrderRejected |
||||
parseStatus "sl_executed" = Just OrderSLExecuted |
||||
parseStatus "sl_forwarding" = Just OrderSLForwarding |
||||
parseStatus "sl_guardtime" = Just OrderSLGuardTime |
||||
parseStatus "tp_correction" = Just OrderTPCorrection |
||||
parseStatus "tp_correction_guardtime" = Just OrderTPCorrectionGuardTime |
||||
parseStatus "tp_executed" = Just OrderTPExecuted |
||||
parseStatus "tp_forwarding" = Just OrderTPForwarding |
||||
parseStatus "tp_guardtime" = Just OrderTPGuardTime |
||||
parseStatus "watching" = Just OrderWatching |
||||
parseStatus _ = Nothing |
||||
|
||||
data TradeNotification = |
||||
TradeNotification |
||||
{ |
||||
secId :: Int |
||||
, tradeNo :: Int64 |
||||
, orderNo :: Int64 |
||||
, board :: T.Text |
||||
, secCode :: T.Text |
||||
, client :: T.Text |
||||
, union :: T.Text |
||||
, buysell :: TradeDirection |
||||
, timestamp :: UTCTime |
||||
, value :: Double |
||||
, comission :: Double |
||||
, price :: Double |
||||
} deriving (Show, Eq, Ord) |
||||
|
||||
newtype ResponseTrades = |
||||
ResponseTrades [TradeNotification] |
||||
deriving (Show, Eq, Ord) |
||||
|
||||
instance TransaqResponseC ResponseTrades where |
||||
fromXml root = do |
||||
quotes <- mapM parseTrade $ elChildren root |
||||
pure . ResponseTrades . catMaybes $ quotes |
||||
where |
||||
parseTrade tag = do |
||||
secId <- childContent "secid" tag >>= readMaybe |
||||
tradeNo <- childContent "tradeno" tag >>= readMaybe |
||||
orderNo <- childContent "orderno" tag >>= readMaybe |
||||
board <- T.pack <$> childContent "board" tag |
||||
secCode <- T.pack <$> childContent "seccode" tag |
||||
client <- T.pack <$> childContent "client" tag |
||||
union <- T.pack <$> childContent "union" tag |
||||
buysell <- childContent "buysell" tag >>= parseTradeDirection . T.pack |
||||
timestamp <- childContent "time" tag >>= parseTimestamp . T.pack |
||||
value <- childContent "value" tag >>= readMaybe |
||||
comission <- childContent "comission" tag >>= readMaybe |
||||
price <- childContent "price" tag >>= readMaybe |
||||
pure . Just $ TradeNotification {..} |
||||
|
||||
data Tick = |
||||
Tick |
||||
{ |
||||
secId :: Int |
||||
, tradeNo :: Int64 |
||||
, timestamp :: UTCTime |
||||
, price :: Double |
||||
, quantity :: Int |
||||
, period :: TradingPeriod |
||||
, buySell :: TradeDirection |
||||
, openInterest :: Int |
||||
, board :: T.Text |
||||
, secCode :: T.Text |
||||
} deriving (Show, Eq, Ord) |
||||
|
||||
newtype ResponseTicks = |
||||
ResponseTicks [Tick] |
||||
deriving (Show, Eq, Ord) |
||||
|
||||
data TransaqResponse = |
||||
TransaqResponseResult ResponseResult |
||||
| TransaqResponseCandles ResponseCandles |
||||
| TransaqResponseServerStatus ResponseServerStatus |
||||
| TransaqResponseMarkets ResponseMarkets |
||||
| TransaqResponseCandleKinds ResponseCandleKinds |
||||
| TransaqResponseSecurities ResponseSecurities |
||||
| TransaqResponseSecInfo ResponseSecInfo |
||||
| TransaqResponseQuotations ResponseQuotations |
||||
| TransaqResponseAllTrades ResponseAllTrades |
||||
| TransaqResponseQuotes ResponseQuotes |
||||
| TransaqResponseOrders ResponseOrders |
||||
| TransaqResponseTrades ResponseTrades |
||||
deriving (Show, Eq, Ord) |
||||
|
||||
instance TransaqResponseC TransaqResponse where |
||||
fromXml root = case qName . elName $ root of |
||||
"result" -> TransaqResponseResult <$> fromXml root |
||||
"error" -> TransaqResponseResult <$> fromXml root |
||||
"candles" -> TransaqResponseCandles <$> fromXml root |
||||
"server_status" -> TransaqResponseServerStatus <$> fromXml root |
||||
"markets" -> TransaqResponseMarkets <$> fromXml root |
||||
"candlekinds" -> TransaqResponseCandleKinds <$> fromXml root |
||||
"securities" -> TransaqResponseSecurities <$> fromXml root |
||||
"sec_info" -> TransaqResponseSecInfo <$> fromXml root |
||||
"quotations" -> TransaqResponseQuotations <$> fromXml root |
||||
"alltrades" -> TransaqResponseAllTrades <$> fromXml root |
||||
"quotes" -> TransaqResponseQuotes <$> fromXml root |
||||
"orders" -> TransaqResponseOrders <$> fromXml root |
||||
"trades" -> TransaqResponseTrades <$> fromXml root |
||||
_ -> Nothing |
||||
@ -0,0 +1,17 @@
@@ -0,0 +1,17 @@
|
||||
module Version |
||||
( |
||||
transaqConnectorVersion, |
||||
transaqConnectorVersionText |
||||
) where |
||||
|
||||
import qualified Data.Text as T |
||||
import Data.Version |
||||
import Paths_transaq_connector |
||||
|
||||
|
||||
transaqConnectorVersion :: Version |
||||
transaqConnectorVersion = version |
||||
|
||||
transaqConnectorVersionText :: T.Text |
||||
transaqConnectorVersionText = T.pack $ showVersion version |
||||
|
||||
@ -0,0 +1,79 @@
@@ -0,0 +1,79 @@
|
||||
# This file was automatically generated by 'stack init' |
||||
# |
||||
# Some commonly used options have been documented as comments in this file. |
||||
# For advanced use and comprehensive documentation of the format, please see: |
||||
# https://docs.haskellstack.org/en/stable/yaml_configuration/ |
||||
|
||||
# Resolver to choose a 'specific' stackage snapshot or a compiler version. |
||||
# A snapshot resolver dictates the compiler version and the set of packages |
||||
# to be used for project dependencies. For example: |
||||
# |
||||
# resolver: lts-3.5 |
||||
# resolver: nightly-2015-09-21 |
||||
# resolver: ghc-7.10.2 |
||||
# |
||||
# The location of a snapshot can be provided as a file or url. Stack assumes |
||||
# a snapshot provided as a file might change, whereas a url resource does not. |
||||
# |
||||
# resolver: ./custom-snapshot.yaml |
||||
# resolver: https://example.com/snapshots/2018-01-01.yaml |
||||
resolver: lts-18.18 |
||||
|
||||
# User packages to be built. |
||||
# Various formats can be used as shown in the example below. |
||||
# |
||||
# packages: |
||||
# - some-directory |
||||
# - https://example.com/foo/bar/baz-0.0.2.tar.gz |
||||
# subdirs: |
||||
# - auto-update |
||||
# - wai |
||||
packages: |
||||
- . |
||||
- ../libatrade |
||||
- ../zeromq4-haskell-zap |
||||
- ../eventcounters |
||||
|
||||
# Dependency packages to be pulled from upstream that are not in the resolver. |
||||
# These entries can reference officially published versions as well as |
||||
# forks / in-progress versions pinned to a git hash. For example: |
||||
# |
||||
# extra-deps: |
||||
# - acme-missiles-0.3 |
||||
# - git: https://github.com/commercialhaskell/stack.git |
||||
# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a |
||||
# |
||||
extra-deps: |
||||
- datetime-0.3.1 |
||||
- co-log-0.4.0.1@sha256:3d4c17f37693c80d1aa2c41669bc3438fac3e89dc5f479e57d79bc3ddc4dfcc5,5087 |
||||
- ansi-terminal-0.10.3@sha256:e2fbcef5f980dc234c7ad8e2fa433b0e8109132c9e643bc40ea5608cd5697797,3226 |
||||
- proto3-suite-0.5.1@sha256:045994919b105b89c44e3ae94f50258b86a6ebfd14425845e13e0921d2e8610e,7015 |
||||
- clock-0.8@sha256:b4ae207e2d3761450060a0d0feb873269233898039c76fceef9cc1a544067767,4113 |
||||
|
||||
|
||||
# Override default flag values for local packages and extra-deps |
||||
# flags: {} |
||||
flags: |
||||
mintty: |
||||
Win32-2-13-1: false |
||||
|
||||
# Extra package databases containing global packages |
||||
# extra-package-dbs: [] |
||||
|
||||
# Control whether we use the GHC we find on the path |
||||
# system-ghc: true |
||||
# |
||||
# Require a specific version of stack, using version ranges |
||||
# require-stack-version: -any # Default |
||||
# require-stack-version: ">=2.7" |
||||
# |
||||
# Override the architecture used by stack, especially useful on Windows |
||||
# arch: i386 |
||||
# arch: x86_64 |
||||
# |
||||
# Extra directories used by stack for building |
||||
# extra-include-dirs: [/path/to/dir] |
||||
# extra-lib-dirs: [/path/to/dir] |
||||
# |
||||
# Allow a newer minor version of GHC than the snapshot specifies |
||||
# compiler-check: newer-minor |
||||
@ -0,0 +1,47 @@
@@ -0,0 +1,47 @@
|
||||
# This file was autogenerated by Stack. |
||||
# You should not edit this file by hand. |
||||
# For more information, please see the documentation at: |
||||
# https://docs.haskellstack.org/en/stable/lock_files |
||||
|
||||
packages: |
||||
- completed: |
||||
hackage: datetime-0.3.1@sha256:7e275bd0ce7a2f66445bedfa0006abaf4d41af4c2204c3f8004c17eab5480e74,1534 |
||||
pantry-tree: |
||||
size: 334 |
||||
sha256: d41d182c143676464cb1774f0b7777e870ddeaf8b6cd5fee6ff0114997a1f504 |
||||
original: |
||||
hackage: datetime-0.3.1 |
||||
- completed: |
||||
hackage: co-log-0.4.0.1@sha256:3d4c17f37693c80d1aa2c41669bc3438fac3e89dc5f479e57d79bc3ddc4dfcc5,5087 |
||||
pantry-tree: |
||||
size: 1126 |
||||
sha256: e73165ff8f744709428e2e87984c9d60ca1cec43d8455c413181c7c466e7497c |
||||
original: |
||||
hackage: co-log-0.4.0.1@sha256:3d4c17f37693c80d1aa2c41669bc3438fac3e89dc5f479e57d79bc3ddc4dfcc5,5087 |
||||
- completed: |
||||
hackage: ansi-terminal-0.10.3@sha256:e2fbcef5f980dc234c7ad8e2fa433b0e8109132c9e643bc40ea5608cd5697797,3226 |
||||
pantry-tree: |
||||
size: 1461 |
||||
sha256: 02f05d52be3ffcf36c78876629cbab80b63420672685371aea4fd10e1c4aabb6 |
||||
original: |
||||
hackage: ansi-terminal-0.10.3@sha256:e2fbcef5f980dc234c7ad8e2fa433b0e8109132c9e643bc40ea5608cd5697797,3226 |
||||
- completed: |
||||
hackage: proto3-suite-0.5.1@sha256:045994919b105b89c44e3ae94f50258b86a6ebfd14425845e13e0921d2e8610e,7015 |
||||
pantry-tree: |
||||
size: 3402 |
||||
sha256: 7387c16e46bdcbcfdfc87b42a1dfd17bf6f7168a50b409469d993f7f73a6f133 |
||||
original: |
||||
hackage: proto3-suite-0.5.1@sha256:045994919b105b89c44e3ae94f50258b86a6ebfd14425845e13e0921d2e8610e,7015 |
||||
- completed: |
||||
hackage: clock-0.8@sha256:b4ae207e2d3761450060a0d0feb873269233898039c76fceef9cc1a544067767,4113 |
||||
pantry-tree: |
||||
size: 446 |
||||
sha256: d9ac8ce6a19812fe74cb1e74228e6e624eda19021ff4d12e24611f88abacd38a |
||||
original: |
||||
hackage: clock-0.8@sha256:b4ae207e2d3761450060a0d0feb873269233898039c76fceef9cc1a544067767,4113 |
||||
snapshots: |
||||
- completed: |
||||
size: 586296 |
||||
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/18.yaml |
||||
sha256: 63539429076b7ebbab6daa7656cfb079393bf644971156dc349d7c0453694ac2 |
||||
original: lts-18.18 |
||||
@ -0,0 +1,62 @@
@@ -0,0 +1,62 @@
|
||||
name: transaq-connector |
||||
version: 0.1.0.0 |
||||
-- synopsis: |
||||
-- description: |
||||
homepage: https://github.com/githubuser/transaq-connector#readme |
||||
license: BSD3 |
||||
license-file: LICENSE |
||||
author: Denis Tereshkin |
||||
maintainer: denis@kasan.ws |
||||
copyright: 2023 Denis Tereshkin |
||||
category: Web |
||||
build-type: Simple |
||||
cabal-version: >=1.10 |
||||
extra-source-files: README.md |
||||
CHANGELOG.md |
||||
|
||||
executable transaq-connector |
||||
hs-source-dirs: src |
||||
main-is: Main.hs |
||||
other-modules: Config |
||||
, TickTable |
||||
, Transaq |
||||
, Version |
||||
, TXML |
||||
, TXMLConnector |
||||
, Paths_transaq_connector |
||||
default-extensions: OverloadedStrings |
||||
, MultiWayIf |
||||
default-language: Haskell2010 |
||||
build-depends: base >= 4.7 && < 5 |
||||
, dhall |
||||
, eventcounters |
||||
, libatrade |
||||
, text |
||||
, transformers |
||||
, co-log |
||||
, zeromq4-haskell |
||||
, aeson |
||||
, bytestring |
||||
, BoundedChan |
||||
, containers |
||||
, xml |
||||
, Decimal |
||||
, time |
||||
, attoparsec |
||||
, stm |
||||
, extra |
||||
, errors |
||||
extra-lib-dirs: lib |
||||
ghc-options: -Wall |
||||
-Wcompat |
||||
-Widentities |
||||
-Wincomplete-record-updates |
||||
-Wincomplete-uni-patterns |
||||
-Wmissing-export-lists |
||||
-Wmissing-home-modules |
||||
-Wpartial-fields |
||||
-Wredundant-constraints |
||||
-threaded -rtsopts -with-rtsopts=-N |
||||
if os(windows) |
||||
extra-libraries: txmlconnector64 |
||||
|
||||
Loading…
Reference in new issue