diff --git a/ex/Main.hs b/ex/Main.hs new file mode 100644 --- /dev/null +++ b/ex/Main.hs @@ -0,0 +1,83 @@ +-- | +-- Module : IB.Client +-- License : GPL3 +-- Author : Robert Bermani +-- Stability : experimental +-- | + +-- Main Loop example + +module Main where + +import Control.Concurrent (forkIO, threadDelay) +import Control.Concurrent.MVar +import Control.Exception +import Control.Monad +import Data.Attoparsec.ByteString.Char8 hiding (try) +import Data.Bits +import qualified Network.Socket as S hiding (send, recv, sendTo, recvFrom) +import Network.Socket.ByteString +import Network.BSD +import Data.List +import System.Timeout +import System.IO +import qualified Data.ByteString.Char8 as B +import Data.Maybe +import System.Posix.Time +import System.Posix.Types +import Foreign.C.Types +import Data.IORef + +import IB.Client.Types +import IB.Client.Nums +import IB.Client.Request +import IB.Client.Exception +import IB.Client.Parser +import IB.Client + + +handleMsg :: MIB -> IBMessage -> IO () +handleMsg msv (CurrentTime time) = + do s <- readMVar msv + putStrLn $ "Current Time Response Received " ++ show time +handleMsg msv (ManagedAccts acct) = + do putStrLn $ "Managed Accts: " ++ acct +handleMsg msv msg = putStrLn $ "Catch-all handler called for " ++ show msg + +{-- +nothreadEx = do let cconf = defaultConf { cc_handler = Just handleMsg } + result <- connect cconf False False + case result of + Left err -> + Right msv -> do s <- readMVar msv + unless (not s_connected s) + do checkMsg False + +threadEx = do let cconf = defaultConf { cc_handler = Just handleMsg } + result <- connect cconf True False + case result of + Left err -> + Right msv -> do s <- readMVar msv + + unless (not s_connected s) checkMsg False +--} +main :: IO () +main = + do result <- connect defaultConf { cc_handler = Just handleMsg } False True + case result of + Left err -> putStrLn "Unable to Connect" + Right msv -> do businessLogic msv + + +businessLogic :: MIB -> IO () +businessLogic msv = + do s <- readMVar msv + + CTime ptime <- epochTime + when (s_connected s) $ + do checkMsg msv False + when (((toInteger ptime) `mod` 120) == 0) $ + do putStrLn $ "Inside do block" ++ show (toInteger ptime) + request s CurrentTimeReq + threadDelay (10^6) + businessLogic msv diff --git a/ib-api.cabal b/ib-api.cabal --- a/ib-api.cabal +++ b/ib-api.cabal @@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.1.0.0 +version: 0.1.0.1 -- A short (one-line) description of the package. synopsis: An API for the Interactive Brokers Trading Workstation written in pure Haskell @@ -51,7 +51,7 @@ library -- Modules exported by the library. - exposed-modules: Examples.Example, IB.Client, IB.Client.Parser, IB.Client.Exception, IB.Client.Types, IB.Client.Request, IB.Client.Nums + exposed-modules: IB.Client, IB.Client.Parser, IB.Client.Exception, IB.Client.Types, IB.Client.Request, IB.Client.Nums -- Modules included in this library but not exported. -- other-modules: @@ -67,4 +67,17 @@ -- Base language which the package is written in. default-language: Haskell2010 + +executable ex + -- LANGUAGE extensions used by modules in this package. + other-extensions: NamedFieldPuns, DeriveDataTypeable, BangPatterns + + main-is: Main.hs + -- Other library packages from which modules are imported. + build-depends: base >=4.6 && < 6, unix >=2.5.1.0 && <=2.7.1.0, ib-api <= 0.1.0.0, network >=2.6 && <2.7, bytestring >=0.10 && <0.11, attoparsec >=0.12 && <0.13 + -- Directories containing source files. + hs-source-dirs: ex + + -- Base language which the package is written in. + default-language: Haskell2010 diff --git a/src/Examples/Example.hs b/src/Examples/Example.hs deleted file mode 100644 --- a/src/Examples/Example.hs +++ /dev/null @@ -1,34 +0,0 @@ --- | --- Module : IB.Client --- License : GPL3 --- Author : Robert Bermani --- Stability : experimental --- | - --- Main Loop example - -module Examples.Example where - -import IB.Client -{-- -handleMsg :: MIB -> IBMessage -> IO () -handleMsg msv ibMsg = - -nothreadEx = do let cconf = defaultConf { cc_handler = Just handleMsg } - result <- connect cconf False False - case result of - Left err -> - Right msv -> do s <- readMVar msv - unless (not s_connected s) - do checkMsg False - -threadEx = do let cconf = defaultConf { cc_handler = Just handleMsg } - result <- connect cconf True False - case result of - Left err -> - Right msv -> do s <- readMVar msv - - unless (not s_connected s) checkMsg False - -main = ---} diff --git a/src/IB/Client.hs b/src/IB/Client.hs --- a/src/IB/Client.hs +++ b/src/IB/Client.hs @@ -3,7 +3,6 @@ -- License : GPL3 -- Author : Robert Bermani -- Stability : experimental --- | -- IB Client @@ -19,6 +18,7 @@ import Network.Socket.ByteString import Network.BSD import Data.List +import Data.Char import System.Timeout import System.IO import qualified Data.ByteString.Char8 as B @@ -49,34 +49,38 @@ , s_connected = False } +ascCodes :: B.ByteString -> String +ascCodes inp = unwords ( map (show . ord) (B.unpack inp) ) + greetServer :: IBServer -> IO IBServer greetServer server = - do write server $ show' client_version + do write server $ appNull $ show' client_version wFlush server let h = fromJust (s_sock server ) extraAuth = s_extraAuth server - msg <- B.hGet h 128 - let prea = parse pServerVersion msg + msg <- B.hGet h 25 + prea <- parseWith (B.hGetNonBlocking h 25) pServerVersion msg case eitherResult prea of Left errMsg -> throwIO $ IBExc no_valid_id ParseError errMsg Right val -> do let serv_ver = pre_serverVersion val twsTime = pre_twsTime val + sCo = server { s_connected = True + , s_version = serv_ver + , s_twsTime = twsTime + } case () of _ | serv_ver < server_version -> throwIO $ IBExc no_valid_id UpdateTWS "" | serv_ver >= 3 -> if (serv_ver < min_server_ver_linking) - then do write server $ show' $ s_clientId server - else return () - | not extraAuth -> request server StartApi + then write sCo $ show' ( s_clientId sCo) + else if (not extraAuth) + then request sCo StartApi + else return () | otherwise -> return () - wFlush server - return server { s_twsTime = twsTime - , s_version = serv_ver - , s_connected = True - } - + wFlush sCo + return sCo checkMsg :: MIB -> Bool -> IO () @@ -85,26 +89,24 @@ let h = fromJust $ s_sock s handleMsg = s_handler s ver = s_version s - eof <- timeout (s_timeoutInterval s) $ hIsEOF h + eof <- timeout (s_timeoutInterval s) (hIsEOF h) - if (eof /= Just False) - then do - modifyMVar_ mvs (\serv -> return $ serv {s_sock = Nothing}) - hClose h - else do - msg <- B.hGet h 4096 - server <- takeMVar mvs - debugWrite server $ ">> " ++ (B.unpack msg) - putMVar mvs server - pResult <- parseWith (B.hGet h 1024) (pRecvMsg ver) msg + case eof of + Nothing -> return () + Just True -> do putStrLn "EOF encountered on handle" + modifyMVar_ mvs (\serv -> return $ serv {s_sock = Nothing}) + hClose h + Just False -> do msg <- B.hGetNonBlocking h 1024 + server <- takeMVar mvs + debugWrite server $ ">> " ++ B.unpack msg + putMVar mvs server + pResult <- parseWith (B.hGetNonBlocking h 1024) (pRecvMsg ver) msg - case eitherResult pResult of - Left errMsg -> throwIO $ IBExc no_valid_id ParseError errMsg - Right res -> handleMsg mvs $ rc_msgBody res - - if (loop) - then checkMsg mvs loop - else return () + case eitherResult pResult of + Left errMsg -> throwIO $ IBExc no_valid_id ParseError errMsg + Right res -> handleMsg mvs $ rc_msgBody res + + when loop $ checkMsg mvs loop -- |Connects to a server connect :: ClientConfig -- ^ Configuration @@ -113,8 +115,8 @@ -> IO (Either IOError MIB) -- ^ IB instance connect cconf threaded debug = try $ do - (when debug $ - putStrLn $ "Connecting to " ++ cc_addr cconf) + when debug $ + putStrLn $ "Connecting to " ++ cc_addr cconf ++ " on port " ++ show (cc_port cconf) -- if (isConnected $ cc_socket cconf) -- then throwIO IBExc no_valid_id AlreadyConnected "" @@ -125,7 +127,7 @@ portStr = show $ cc_port cconf hostname | null hostStr = Nothing | otherwise = Just hostStr - addrinfos <- ( S.getAddrInfo Nothing hostname (Just portStr)) + addrinfos <- S.getAddrInfo Nothing hostname (Just portStr) let serveraddr = head addrinfos s <- S.socket (S.addrFamily serveraddr) S.Stream defaultProtocol @@ -156,13 +158,18 @@ , s_extraAuth = cc_extraAuth cc , s_handler = fromJust $ cc_handler cc , s_debug = debug + , s_twsTime = "" + , s_msgThread = Nothing + , s_version = 0 , s_sock = Just h + , s_timeoutInterval = 100000 + , s_connected = False } defaultConf :: ClientConfig -defaultConf = ClientConfig { cc_addr = "" - , cc_port = 5555 - , cc_clientId = 1 +defaultConf = ClientConfig { cc_addr = "127.0.0.1" + , cc_port = 7496 + , cc_clientId = 0 , cc_extraAuth = False , cc_handler = Just defHandler } diff --git a/src/IB/Client/Parser.hs b/src/IB/Client/Parser.hs --- a/src/IB/Client/Parser.hs +++ b/src/IB/Client/Parser.hs @@ -13,9 +13,11 @@ ) where --import Data.ByteString hiding (elem, map, empty) +import Prelude hiding (takeWhile, take) import qualified Data.ByteString.Char8 as C import Control.Monad import Control.Applicative +import Data.Char hiding (takeWhile) import Data.Attoparsec.ByteString.Char8 import IB.Client.Types @@ -24,19 +26,12 @@ pServerVersion :: Parser Preamble pServerVersion = do pre_serverVersion <- pStrInt - let pre_twsTime = 0 - - if (pre_serverVersion >= 20) - then do pre_twsTime <- pStrInt - return () - else return () - - --if (serv_ver >= 20) - -- then do twsTime <- pStrInt - -- else let twsTime = 0 - - return Preamble {pre_serverVersion, pre_twsTime } + if pre_serverVersion >= 20 + then do pre_twsTime <- pStr + return $ Preamble {pre_serverVersion, pre_twsTime} + else do return $ Preamble {pre_serverVersion, pre_twsTime = "" } + pRecvMsg :: Int -> Parser RecvMsg pRecvMsg sver = do rc_msgId <- pStrInt @@ -58,17 +53,17 @@ } +pBStr :: Parser C.ByteString +pBStr = takeWhile1 (/= chr 0) <* take 1 + pStr :: Parser String -pStr = do bs <- takeWhile1 (\w -> w /= '\0') - return (C.unpack bs) +pStr = C.unpack <$> pBStr pStrMaybe :: Parser (Maybe String) -pStrMaybe = do bs <- takeWhile1 (\w -> w /= '\0') +pStrMaybe = do bs <- takeWhile1 (/= chr 0) let str = C.unpack bs - - return $ case null str of - True -> Nothing - False -> Just str + take 1 + return (if null str then Nothing else Just str) pStrIntMax :: Parser Int pStrIntMax = do res <- pStrMaybe @@ -141,42 +136,9 @@ "Acct Value" pPortfolioValue :: Int -> Int -> Parser IBMessage -pPortfolioValue _ ver = - do ct_conId <- pStrInt - ct_symbol <- pStr - ct_secType <- pStr - ct_expiry <- pStr - ct_strike <- pStrDouble - ct_right <- pStr - let ct_multiplier = "" - ct_tradingClass = "" - - if (ver >= 7) - then do ct_multiplier <- pStr - return () - else return () - - ct_exchange <- pStr - ct_currency <- pStr - ct_localSymbol <- pStr - - if (ver >= 8) - then do ct_tradingClass <- pStr - return () - else return () +pPortfolioValue sver ver = + do contract <- pContractHead sver ver (7,8) - let contract = Contract { ct_conId - , ct_symbol - , ct_secType - , ct_expiry - , ct_strike - , ct_right - , ct_multiplier - , ct_exchange - , ct_currency - , ct_localSymbol - , ct_tradingClass - } position <- pStrInt marketPrice <- pStrDouble marketValue <- pStrDouble @@ -185,10 +147,15 @@ realizedPNL <- pStrDouble accountName <- pStr + when (ver == 6 && sver == 39) $ + do ct_primaryExchange <- pStr + return () + return PortfolioValue { contract , position , marketPrice , averageCost + , marketValue , unrealizedPNL , realizedPNL , accountName @@ -262,51 +229,22 @@ "Fundamental Data" pPositionData :: Int -> Int -> Parser IBMessage -pPositionData _ ver = do account <- pStr - contract <- pContract' - position <- pStrInt - let avgCost = dblMaximum - - if (ver >= 3) - then do avgCost <- pStrDouble - return () - else return () - - return PositionData { account - , contract - , position - , avgCost - } - where pContract' = - do ct_conId <- pStrInt - ct_symbol <- pStr - ct_secType <- pStr - ct_expiry <- pStr - ct_strike <- pStrDouble - ct_right <- pStr - ct_multiplier <- pStr - ct_exchange <- pStr - ct_currency <- pStr - ct_localSymbol <- pStr - let ct_tradingClass = "" +pPositionData sver ver = + do account <- pStr + contract <- pContractHead sver ver (0,2) + position <- pStrInt + let avgCost = dblMaximum - if (ver >= 2) - then do ct_tradingClass <- pStr - return () - else return () + when (ver >= 3) $ + do avgCost <- pStrDouble + return () - return Contract { ct_conId - , ct_symbol - , ct_secType - , ct_expiry - , ct_strike - , ct_right - , ct_multiplier - , ct_exchange - , ct_currency - , ct_localSymbol - , ct_tradingClass - } + return PositionData { account + , contract + , position + , avgCost + } + pPositionEnd :: Int -> Int -> Parser IBMessage pPositionEnd _ _ = return PositionEnd @@ -407,8 +345,8 @@ -- else let evRule = "" -- evMultiplier = dblMaximum -pExecution :: Int -> Int -> Parser Execution -pExecution _ ver = +pExecution :: Int -> Int -> Int -> Parser Execution +pExecution _ ver oid = do ex_execId <- pStr ex_time <- pStr ex_acctNumber <- pStr @@ -425,7 +363,7 @@ ex_orderRef = "" ex_evRule = "" ex_evMultiplier = dblMaximum - + ex_orderId = oid case () of _ | ver >= 9 -> do ex_cumQty <- pStrInt ex_avgPrice <- pStrDouble @@ -448,6 +386,7 @@ , ex_exchange , ex_side , ex_shares + , ex_orderId , ex_price , ex_permId , ex_clientId @@ -459,54 +398,64 @@ , ex_evMultiplier } -pExecutionData :: Int -> Int -> Parser IBMessage -pExecutionData _ ver = do reqId <- pStrInt - orderId <- pStrInt - contract <- pContract' - exec <- pExecution 0 ver - return ExecutionData { reqId - , orderId - , contract - , exec - } - where pContract' :: Parser Contract - pContract' = - do ct_conId <- pStrInt - ct_symbol <- pStr - ct_secType <- pStr - ct_expiry <- pStr - ct_strike <- pStrDouble - ct_right <- pStr - - let ct_multiplier = "" - ct_tradingClass = "" +pContractHead :: Int -> Int -> (Int, Int) -> Parser Contract +pContractHead _ ver vercheck@(lwr, uppr) = + do ct_conId <- pStrInt + ct_symbol <- pStr + ct_secType <- pStr + ct_expiry <- pStr + ct_strike <- pStrDouble + ct_right <- pStr + + let ct_multiplier = "" + ct_tradingClass = "" + ct_primaryExchange = "" + ct_includeExpired = False + ct_secIdType = "" + ct_comboLegsDescrip = "" + ct_comboLegsList = [] + + when (ver >= lwr) $ + do ct_multiplier <- pStr + ct_primaryExchange <- pStr + return () - if (ver >= 9) - then do ct_multiplier <- pStr - return () - else return () + ct_exchange <- pStr + ct_currency <- pStr + ct_localSymbol <- pStr + + when (ver >= uppr) $ + do ct_tradingClass <- pStr + return () - ct_exchange <- pStr - ct_currency <- pStr - ct_localSymbol <- pStr - - if (ver >= 10) - then do ct_tradingClass <- pStr - return () - else return () + return defContract { ct_conId + , ct_symbol + , ct_secType + , ct_expiry + , ct_strike + , ct_includeExpired + , ct_secIdType + , ct_comboLegsDescrip + , ct_comboLegsList + , ct_right + , ct_multiplier + , ct_exchange + , ct_primaryExchange + , ct_currency + , ct_localSymbol + , ct_tradingClass + } - return Contract { ct_conId - , ct_symbol - , ct_secType - , ct_expiry - , ct_strike - , ct_right - , ct_multiplier - , ct_exchange - , ct_currency - , ct_localSymbol - , ct_tradingClass - } +pExecutionData :: Int -> Int -> Parser IBMessage +pExecutionData sver ver = + do reqId <- pStrInt + orderId <- pStrInt + contract <- pContractHead sver ver (9,10) + exec <- pExecution 0 ver orderId + return ExecutionData { reqId + , contract + , exec + } pMarketDepth :: Int -> Int -> Parser IBMessage pMarketDepth _ _ = MarketDepth <$> @@ -532,9 +481,30 @@ pBondContractData :: Int -> Int -> Parser IBMessage pBondContractData _ ver = do let reqId = -1 - if (ver >= 3) then do reqId <- pStrInt - return () - else return () + ct_expiry = "" + ct_strike = 0.0 + ct_right = "" + ct_multiplier = "" + ct_primaryExchange = "" + ct_localSymbol = "" + ct_includeExpired = False + ct_secIdType = "" + ct_secId = "" + ct_comboLegsDescrip = "" + ct_comboLegsList = [] + ctd_priceMagnifier = 0 + ctd_underConId = 0 + ctd_contractMonth = "" + ctd_industry = "" + ctd_subcategory = "" + ctd_timeZoneId = "" + ctd_tradingHours = "" + ctd_liquidHours = "" + + when (ver >= 3) $ + do reqId <- pStrInt + return () + ct_symbol <- pStr ct_secType <- pStr ctd_cusip <- pStr @@ -561,8 +531,19 @@ ctd_nextOptionPartial <- pStrBool ctd_notes <- pStr - let ctd_summary = Contract { ct_symbol + let ctd_summary = defContract { ct_symbol , ct_secType + , ct_expiry + , ct_strike + , ct_right + , ct_multiplier + , ct_primaryExchange + , ct_localSymbol + , ct_includeExpired + , ct_secIdType + , ct_secId + , ct_comboLegsDescrip + , ct_comboLegsList , ct_exchange , ct_currency , ct_tradingClass @@ -585,7 +566,7 @@ | ver >= 4 -> do ctd_longName <- pStr return () - let ctd = ContractDetails { ctd_summary + let ctd = defContractDetails { ctd_summary , ctd_marketName , ctd_minTick , ctd_orderTypes @@ -609,6 +590,14 @@ , ctd_maturity , ctd_coupon , ctd_cusip + , ctd_priceMagnifier + , ctd_underConId + , ctd_contractMonth + , ctd_industry + , ctd_subcategory + , ctd_timeZoneId + , ctd_tradingHours + , ctd_liquidHours } return $ BondContractData ctd @@ -619,13 +608,36 @@ <*> pStr <*> pStr "News Bulletins" + pContractData :: Int -> Int -> Parser IBMessage pContractData _ ver = do let reqId = -1 - if (ver >= 3) then do reqId <- pStrInt - return () - else return () + ct_conId = 0 + ct_tradingClass = "" + ct_includeExpired = False + ct_secIdType = "" + ct_secId = "" + ct_comboLegsDescrip = "" + ct_comboLegsList = [] + ctd_secIdList = [] + ctd_evMultiplier = dblMaximum + ctd_evRule = "" + ctd_liquidHours = "" + ctd_tradingHours = "" + ctd_subcategory = "" + ctd_category = "" + ctd_industry = "" + ctd_contractMonth = "" + ctd_primaryExchange = "" + ctd_longName = "" + ctd_timeZoneId = "" + ctd_underConId = int32max + + when (ver >= 3) $ + do reqId <- pStrInt + return () + ct_symbol <- pStr ct_secType <- pStr ct_expiry <- pStr @@ -641,51 +653,44 @@ ctd_validExchanges <- pStr ctd_priceMagnifier <- pStrInt - let ctd_underConId = int32max - ctd_longName = "" - ct_primaryExchange = "" - ctd_evRule = "" - ctd_evMultiplier = dblMaximum - ctd_secIdList = [] - ctd_contractMonth = "" - ctd_industry = "" - ctd_category = "" - ctd_subcategory = "" - ctd_timeZoneId = "" - ctd_tradingHours = "" - ctd_liquidHours = "" + let ct_primaryExchange = "" - if (ver >= 4) then do ctd_underConId <- pStrInt - return () - else return () - if (ver >= 5) then do ctd_longName <- pStr - ct_primaryExchange <- pStr - return () - else return () + when (ver >= 4) $ do ctd_underConId <- pStrInt + return () + + when (ver >= 5) $ do ctd_longName <- pStr + ct_primaryExchange <- pStr + return () - if (ver >= 6) then do ctd_contractMonth <- pStr - ctd_industry <- pStr - ctd_category <- pStr - ctd_subcategory <- pStr - ctd_timeZoneId <- pStr - ctd_tradingHours <- pStr - ctd_liquidHours <- pStr - return () - else return () + when (ver >= 6) $ do ctd_contractMonth <- pStr + ctd_industry <- pStr + ctd_category <- pStr + ctd_subcategory <- pStr + ctd_timeZoneId <- pStr + ctd_tradingHours <- pStr + ctd_liquidHours <- pStr + return () - if (ver >= 8) then do ctd_evRule <- pStr - ctd_evMultiplier <- pStrDouble - return () - else return () + when (ver >= 8) $ do ctd_evRule <- pStr + ctd_evMultiplier <- pStrDouble + return () + - if (ver >= 7) then do ctd_secIdList <- pTagValueCons - return () - else return () + when (ver >= 7) $ do ctd_secIdList <- pTagValueCons + return () + - let ctd_summary = Contract { ct_symbol + let ctd_summary = defContract { ct_symbol , ct_secType , ct_expiry , ct_primaryExchange + , ct_conId + , ct_tradingClass + , ct_includeExpired + , ct_secIdType + , ct_secId + , ct_comboLegsDescrip + , ct_comboLegsList , ct_strike , ct_right , ct_multiplier @@ -694,62 +699,29 @@ , ct_localSymbol } - ctd = ContractDetails { ctd_summary - , ctd_marketName - , ctd_minTick - , ctd_orderTypes - , ctd_validExchanges - , ctd_priceMagnifier - , ctd_underConId - , ctd_longName - , ctd_contractMonth - , ctd_industry - , ctd_category - , ctd_subcategory - , ctd_timeZoneId - , ctd_tradingHours - , ctd_liquidHours - , ctd_evRule - , ctd_evMultiplier - , ctd_secIdList - } + ctd = defContractDetails { ctd_summary + , ctd_marketName + , ctd_minTick + , ctd_orderTypes + , ctd_validExchanges + , ctd_priceMagnifier + , ctd_underConId + , ctd_longName + , ctd_contractMonth + , ctd_industry + , ctd_category + , ctd_subcategory + , ctd_timeZoneId + , ctd_tradingHours + , ctd_liquidHours + , ctd_evRule + , ctd_evMultiplier + , ctd_secIdList + } return $ ContractData ctd -pContract :: Int -> Int -> Parser Contract -pContract _ ver = - do let ct_multiplier = "" - ct_trading_class = "" - ct_conId <- pStrInt - ct_symbol <- pStr - ct_secType <- pStr - ct_expiry <- pStr - ct_strike <- pStrDouble - ct_right <- pStr - if (ver >= 32) - then do ct_multiplier <- pStr - return () - else return () - - ct_exchange <- pStr - ct_currency <- pStr - ct_localSymbol <- pStr - - if (ver >= 32) - then do ct_tradingClass <- pStr - return () - else return () - - return Contract { ct_conId - , ct_symbol - , ct_secType - , ct_expiry - , ct_strike - , ct_right - , ct_multiplier - , ct_exchange - , ct_currency - , ct_localSymbol - } +pContract :: Int -> Int -> Parser Contract +pContract sver ver = pContractHead sver ver (32,32) pOrder :: Int -> Int -> Parser Order pOrder serv_ver ver = @@ -766,14 +738,13 @@ ord_deltaNeutralShortSaleSlot = int32max ord_deltaNeutralDesignatedLocation = "" ord_trailingPercent = dblMaximum - - if (ver < 29) + if ver < 29 then do ord_lmtPrice <- pStrDouble return () else do ord_lmtPrice <- pStrDoubleMax return () - if (ver < 30) + if ver < 30 then do ord_auxPrice <- pStrDouble return () else do ord_auxPrice <- pStrDoubleMax @@ -803,14 +774,15 @@ ord_shortSaleSlot <- pStrInt ord_designatedLocation <- pStr - if (serv_ver == min_server_ver_sshortx_old) - then do pStrInt - return () - else if (ver >= 23) - then do ord_exemptCode <- pStrInt - return () - else return () + when (serv_ver == min_server_ver_sshortx_old) $ + do pStrInt + return () + + when (serv_ver /= min_server_ver_sshortx_old && ver >= 23) $ + do ord_exemptCode <- pStrInt + return () + ord_auctionStrategy <- pStrInt ord_startingPrice <- pStrDoubleMax ord_stockRefPrice <- pStrDoubleMax @@ -833,95 +805,96 @@ ord_deltaNeutralOrderType <- pStr ord_deltaNeutralAuxPrice <- pStrDoubleMax - if (ver >= 27 && not (null ord_deltaNeutralOrderType)) + if ver >= 27 && not (null ord_deltaNeutralOrderType) then do ord_deltaNeutralConId <- pStrInt ord_deltaNeutralSettlingFirm <- pStr ord_deltaNeutralClearingAccount <- pStr ord_deltaNeutralClearingIntent <- pStr return () - else if (ver >= 31 && not (null ord_deltaNeutralOrderType)) - then do ord_deltaNeutralOpenClose <- pStr - ord_deltaNetralShortSale <- pStrBool - ord_deltaNeutralShortSaleSlot <- pStrInt - ord_deltaNeutralDesignatedLocation <- pStr - return () - else return () + else when (ver >= 31 && not (null ord_deltaNeutralOrderType)) $ + do ord_deltaNeutralOpenClose <- pStr + ord_deltaNetralShortSale <- pStrBool + ord_deltaNeutralShortSaleSlot <- pStrInt + ord_deltaNeutralDesignatedLocation <- pStr + return () + ord_continuousUpdate <- pStrBool ord_referencePriceType <- pStrInt ord_trailStopPrice <- pStrDoubleMax - - if (ver >= 30) - then do ord_trailingPercent <- pStrDoubleMax - return () - else return () + + let ord_trailingPercent = dblMaximum + when (ver >= 30) $ + do ord_trailingPercent <- pStrDoubleMax + return () + ord_basisPoints <- pStrDoubleMax ord_basisPointsType <- pStrIntMax let ord_origin = toEnum ord_origin' - return Order { ord_action - , ord_totalQuantity - , ord_orderType - , ord_tif - , ord_ocaGroup - , ord_account - , ord_openClose - , ord_origin - , ord_orderRef - , ord_clientId - , ord_permId - , ord_outsideRth - , ord_hidden - , ord_discretionaryAmt - , ord_goodAfterTime - , ord_faGroup - , ord_faMethod - , ord_faPercentage - , ord_faProfile - , ord_goodTillDate - , ord_rule80A - , ord_percentOffset - , ord_settlingFirm - , ord_shortSaleSlot - , ord_designatedLocation - , ord_exemptCode - , ord_auctionStrategy - , ord_startingPrice - , ord_stockRefPrice - , ord_delta - , ord_stockRangeLower - , ord_stockRangeUpper - , ord_displaySize - , ord_blockOrder - , ord_sweepToFill - , ord_allOrNone - , ord_minQty - , ord_ocaType - , ord_eTradeOnly - , ord_firmQuoteOnly - , ord_nbboPriceCap - , ord_parentId - , ord_triggerMethod - , ord_volatility - , ord_volatilityType - , ord_deltaNeutralOrderType - , ord_deltaNeutralAuxPrice - , ord_deltaNeutralConId - , ord_deltaNeutralSettlingFirm - , ord_deltaNeutralClearingAccount - , ord_deltaNeutralClearingIntent - , ord_deltaNeutralOpenClose - , ord_deltaNeutralShortSale - , ord_deltaNeutralShortSaleSlot - , ord_deltaNeutralDesignatedLocation - , ord_continuousUpdate - , ord_referencePriceType - , ord_trailStopPrice - , ord_trailingPercent - , ord_basisPoints - , ord_basisPointsType - } + return defOrder { ord_action + , ord_totalQuantity + , ord_orderType + , ord_tif + , ord_ocaGroup + , ord_account + , ord_openClose + , ord_origin + , ord_orderRef + , ord_clientId + , ord_permId + , ord_outsideRth + , ord_hidden + , ord_discretionaryAmt + , ord_goodAfterTime + , ord_faGroup + , ord_faMethod + , ord_faPercentage + , ord_faProfile + , ord_goodTillDate + , ord_rule80A + , ord_percentOffset + , ord_settlingFirm + , ord_shortSaleSlot + , ord_designatedLocation + , ord_exemptCode + , ord_auctionStrategy + , ord_startingPrice + , ord_stockRefPrice + , ord_delta + , ord_stockRangeLower + , ord_stockRangeUpper + , ord_displaySize + , ord_blockOrder + , ord_sweepToFill + , ord_allOrNone + , ord_minQty + , ord_ocaType + , ord_eTradeOnly + , ord_firmQuoteOnly + , ord_nbboPriceCap + , ord_parentId + , ord_triggerMethod + , ord_volatility + , ord_volatilityType + , ord_deltaNeutralOrderType + , ord_deltaNeutralAuxPrice + , ord_deltaNeutralConId + , ord_deltaNeutralSettlingFirm + , ord_deltaNeutralClearingAccount + , ord_deltaNeutralClearingIntent + , ord_deltaNeutralOpenClose + , ord_deltaNeutralShortSale + , ord_deltaNeutralShortSaleSlot + , ord_deltaNeutralDesignatedLocation + , ord_continuousUpdate + , ord_referencePriceType + , ord_trailStopPrice + , ord_trailingPercent + , ord_basisPoints + , ord_basisPointsType + } pOrderStatus :: Int -> Int -> Parser IBMessage @@ -956,26 +929,22 @@ pTagValueCons :: Parser [TagValue] pTagValueCons = do listCount <- pStrInt - if (listCount > 0) - then do tvl <- replicateM listCount pTagValue - return tvl - else do return [] + if listCount > 0 + then replicateM listCount pTagValue + else return [] pComboLegCons :: Int -> Int -> Parser [ComboLeg] pComboLegCons _ ver = - if (ver >= 29) then do + if ver >= 29 then do comboLegsCount <- pStrInt - if (comboLegsCount > 0) - then do tvl <- replicateM comboLegsCount pComboLeg - return tvl + if comboLegsCount > 0 + then replicateM comboLegsCount pComboLeg + else return [] else return [] pOrderComboLeg :: Parser OrderComboLeg -pOrderComboLeg = - do ordComboLeg <- pStrDoubleMax - return ordComboLeg - +pOrderComboLeg = pStrDoubleMax pBarData :: Parser BarData pBarData = BarData <$> @@ -1012,7 +981,7 @@ ctd_marketName <- pStr ct_tradingClass <- pStr - let ctd_summary = Contract { ct_conId + let ctd_summary = defContract { ct_conId , ct_symbol , ct_secType , ct_expiry @@ -1023,57 +992,54 @@ , ct_localSymbol , ct_tradingClass } - return ContractDetails { ctd_summary + return defContractDetails { ctd_summary , ctd_marketName} pScanDataList :: Parser [ScanData] pScanDataList = do numberOfElements <- pStrInt - scl <- replicateM numberOfElements pScanData - return scl + replicateM numberOfElements pScanData + pOrderComboLegCons :: Int -> Int -> Parser [OrderComboLeg] pOrderComboLegCons _ ver | ver >= 29 = do orderComboLegsCount <- pStrInt case () of - _ | orderComboLegsCount > 0 -> do ocl <- replicateM orderComboLegsCount pOrderComboLeg - return ocl + _ | orderComboLegsCount > 0 -> replicateM orderComboLegsCount pOrderComboLeg | otherwise -> return [] | otherwise = return [] pBarDataCons :: Parser [BarData] pBarDataCons = do itemCount <- pStrInt - bdl <- replicateM itemCount pBarData - return bdl + replicateM itemCount pBarData pUnderComp' :: Parser UnderComp pUnderComp' = UnderComp <$> pStrInt <*> pStrDouble <*> pStrDouble "UnderComp" pUnderComp :: Int -> Int -> Parser UnderComp pUnderComp _ ver = - do if (ver >= 20) + if ver >= 20 then do underCompPresent <- pStrBool let uc_conId = int32max uc_delta = dblMaximum uc_price = dblMaximum - if (underCompPresent) - then do uc_conId <- pStrInt - uc_delta <- pStrDouble - uc_price <- pStrDouble - return () - else return () + when underCompPresent $ + do uc_conId <- pStrInt + uc_delta <- pStrDouble + uc_price <- pStrDouble + return () return UnderComp {uc_conId, uc_delta, uc_price} - else return UnderComp {} + else return defUnderComp -- TODO: Convert to pattern guard case structure pAlgoStrategy :: Int -> Int -> Parser (String,[TagValue]) pAlgoStrategy _ ver = - do if (ver >= 21) + if ver >= 21 then do algoStrategy <- pStr - if (not (null algoStrategy)) + if not (null algoStrategy) then do algoParamsCount <- pStrInt - if (algoParamsCount > 0) + if algoParamsCount > 0 then do agl <- replicateM algoParamsCount pTagValue return (algoStrategy, agl) else return (empty,[]) @@ -1106,11 +1072,10 @@ comboLeg <- pComboLegCons serv_ver ver orderComboLegs <- pOrderComboLegCons serv_ver ver - if (ver >= 26) then do ord_smartComboRoutingParams <- pTagValueCons - return () - else return () + when (ver >= 26) $ do ord_smartComboRoutingParams <- pTagValueCons + return () - if (ver >= 20) + if ver >= 20 then do ord_scaleInitLevelSize <- pStrIntMax ord_scaleSubsLevelSize <- pStrIntMax return () @@ -1120,36 +1085,34 @@ ord_scalePriceIncrement <- pStrDoubleMax - if (ver >= 28 && ord_scalePriceIncrement > 0.0 && ord_scalePriceIncrement /= dblMaximum) - then do ord_scalePriceAdjustValue <- pStrDoubleMax - ord_scalePriceAdjustInterval <- pStrIntMax - ord_scaleProfitOffset <- pStrDoubleMax - ord_scaleAutoReset <- pStrBool - ord_scaleInitPosition <- pStrIntMax - ord_scaleInitFillQty <- pStrIntMax - ord_scaleRandomPercent <- pStrBool + when (ver >= 28 && ord_scalePriceIncrement > 0.0 && ord_scalePriceIncrement /= dblMaximum) $ + do ord_scalePriceAdjustValue <- pStrDoubleMax + ord_scalePriceAdjustInterval <- pStrIntMax + ord_scaleProfitOffset <- pStrDoubleMax + ord_scaleAutoReset <- pStrBool + ord_scaleInitPosition <- pStrIntMax + ord_scaleInitFillQty <- pStrIntMax + ord_scaleRandomPercent <- pStrBool + return () + + when (ver >= 24) $ + do ord_hedgeType <- pStr + unless (null ord_hedgeType) $ + do ord_hedgeParam <- pStr return () - else return () - if (ver >= 24) - then do ord_hedgeType <- pStr - if (not (null ord_hedgeType)) - then do ord_hedgeParam <- pStr - return () - else return () - return () - else return () - if (ver >= 25) then do ord_optOutSmartRouting <- pStrBool - return () - else return () + when (ver >= 25) $ + do ord_optOutSmartRouting <- pStrBool + return () + ord_clearingAccount <- pStr ord_clearingIntent <- pStr - if (ver >= 22) then do notHeld <- pStrBool - return () - else return () + when (ver >= 22) $ + do notHeld <- pStrBool + return () ct_underComp <- pUnderComp serv_ver ver (ord_algoStrategy, ord_algoParams) <- pAlgoStrategy serv_ver ver @@ -1202,19 +1165,18 @@ impliedVol <- dblCheckNegative <$> pStrDouble delta <- pStrDouble - if (ver >= 6 || tickType == fromEnum MODEL_OPTION) - then do optPrice <- dblCheckNegative <$> pStrDouble - pvDividend <- dblCheckNegative <$> pStrDouble - return () - else return () + when (ver >= 6 || tickType == fromEnum MODEL_OPTION) $ + do optPrice <- dblCheckNegative <$> pStrDouble + pvDividend <- dblCheckNegative <$> pStrDouble + return () - if (ver >= 6) - then do gamma <- dblDefaultCheck <$> pStrDouble - vega <- dblDefaultCheck <$> pStrDouble - theta <- dblDefaultCheck <$> pStrDouble - undPrice <- dblDefaultCheck <$> pStrDouble - return () - else return () + + when (ver >= 6) $ + do gamma <- dblDefaultCheck <$> pStrDouble + vega <- dblDefaultCheck <$> pStrDouble + theta <- dblDefaultCheck <$> pStrDouble + undPrice <- dblDefaultCheck <$> pStrDouble + return () return $ TickOptionComputation tickerId tickType impliedVol delta optPrice pvDividend gamma vega theta undPrice diff --git a/src/IB/Client/Request.hs b/src/IB/Client/Request.hs --- a/src/IB/Client/Request.hs +++ b/src/IB/Client/Request.hs @@ -9,13 +9,14 @@ , request , wFlush , write + , appNull , show' , debugWrite ) where import Control.Concurrent.MVar import Control.Exception -import Control.Monad (when) +import Control.Monad (when, unless) import Text.Printf import qualified System.IO as S import qualified Data.ByteString.Char8 as B @@ -31,25 +32,32 @@ , rqh_proVer :: Int , rqh_errId :: Int , rqh_errMsg :: String - , rqh_minVer :: Int - , rqh_exAuth :: Bool + , rqh_minVer :: Maybe Int + , rqh_exAuth :: Maybe Bool } -defReqHeader = ReqHeader 1 1 no_valid_id "" undefined undefined +defReqHeader = ReqHeader 1 1 no_valid_id "" Nothing Nothing (<++>) :: B.ByteString -> B.ByteString -> B.ByteString -a <++> b = a `B.append` nullch `B.append` b `B.append` nullch +a <++> b = a `B.append` nullch `B.append` b debugWrite :: IBServer -> String -> IO () debugWrite s msg = - (when (s_debug s) $ putStrLn msg) + when (s_debug s) $ putStrLn msg write :: IBServer -> B.ByteString -> IO () write s msg = do debugWrite s $ "<< " ++ B.unpack msg - B.hPutStr h (msg <++> B.pack "\0") + B.hPutStr h msg where h = fromJust $ s_sock s +writeLst :: IBServer -> [B.ByteString] -> IO () +writeLst s bsl = + do let outbs = (B.intercalate nullch bsl) `B.append` nullch + debugWrite s $ "<< " ++ B.unpack outbs + B.hPutStr h outbs + where h = fromJust $ s_sock s + wFlush :: IBServer -> IO () wFlush s = S.hFlush h where h = fromJust $ s_sock s @@ -60,6 +68,9 @@ nullch :: B.ByteString nullch = B.pack "\0" +appNull :: B.ByteString -> B.ByteString +appNull bin = bin `B.append` nullch + encodeDbl :: Double -> B.ByteString encodeDbl val = B.pack (printf "%.2f" val) @@ -74,38 +85,38 @@ | otherwise = encodeDbl val encodeExecutionFilter :: ExecutionFilter -> B.ByteString -encodeExecutionFilter exf = (show' $ exf_clientId exf ) - <++> (B.pack $ exf_acctCode exf) - <++> (B.pack $ exf_time exf) - <++> (B.pack $ exf_symbol exf) - <++> (B.pack $ exf_secType exf) - <++> (B.pack $ exf_exchange exf) - <++> (B.pack $ exf_side exf ) - +encodeExecutionFilter exf = appNull (show' ( exf_clientId exf) + <++> B.pack (exf_acctCode exf) + <++> B.pack ( exf_time exf) + <++> B.pack ( exf_symbol exf) + <++> B.pack ( exf_secType exf) + <++> B.pack ( exf_exchange exf) + <++> B.pack ( exf_side exf )) + encodeSubscription :: ScannerSubscription -> B.ByteString -encodeSubscription subs = (encodeIntMax $ ssb_numberOfRows subs) - <++> (B.pack $ ssb_instrument subs) - <++> (B.pack $ ssb_locationCode subs) - <++> (B.pack $ ssb_scanCode subs) - <++> (encodeDblMax $ ssb_abovePrice subs) - <++> (encodeDblMax $ ssb_belowPrice subs) - <++> (encodeIntMax $ ssb_aboveVolume subs) - <++> (encodeDblMax $ ssb_marketCapAbove subs) - <++> (encodeDblMax $ ssb_marketCapBelow subs) - <++> (B.pack $ ssb_moodyRatingAbove subs) - <++> (B.pack $ ssb_moodyRatingBelow subs) - <++> (B.pack $ ssb_spRatingAbove subs) - <++> (B.pack $ ssb_spRatingBelow subs) - <++> (B.pack $ ssb_maturityDateAbove subs) - <++> (B.pack $ ssb_maturityDateBelow subs) - <++> (encodeDblMax $ ssb_couponRateAbove subs) - <++> (encodeDblMax $ ssb_couponRateBelow subs) - <++> (encodeIntMax $ ssb_excludeConvertible subs) - <++> (encodeIntMax $ ssb_averageOptionVolumeAbove subs) - <++> (B.pack $ ssb_scannerSettingPairs subs) - <++> (B.pack $ ssb_stockTypeFilter subs) - +encodeSubscription subs = appNull $ encodeIntMax ( ssb_numberOfRows subs) + <++> B.pack ( ssb_instrument subs) + <++> B.pack ( ssb_locationCode subs) + <++> B.pack ( ssb_scanCode subs) + <++> encodeDblMax ( ssb_abovePrice subs) + <++> encodeDblMax ( ssb_belowPrice subs) + <++> encodeIntMax ( ssb_aboveVolume subs) + <++> encodeDblMax ( ssb_marketCapAbove subs) + <++> encodeDblMax ( ssb_marketCapBelow subs) + <++> B.pack ( ssb_moodyRatingAbove subs) + <++> B.pack ( ssb_moodyRatingBelow subs) + <++> B.pack ( ssb_spRatingAbove subs) + <++> B.pack ( ssb_spRatingBelow subs) + <++> B.pack ( ssb_maturityDateAbove subs) + <++> B.pack ( ssb_maturityDateBelow subs) + <++> encodeDblMax ( ssb_couponRateAbove subs) + <++> encodeDblMax ( ssb_couponRateBelow subs) + <++> encodeIntMax ( ssb_excludeConvertible subs) + <++> encodeIntMax ( ssb_averageOptionVolumeAbove subs) + <++> B.pack ( ssb_scannerSettingPairs subs) + <++> B.pack ( ssb_stockTypeFilter subs) + encodeTagValue :: TagValue -> B.ByteString encodeTagValue tv = B.pack $ tv_tag tv ++ "=" ++ tv_value tv ++ ";" @@ -114,38 +125,38 @@ encodeTagValueList tvl = B.concat $ map encodeTagValue tvl encodeUnderComp :: UnderComp -> B.ByteString -encodeUnderComp uc = show' 1 <++> (show' $ uc_conId uc ) - <++> (show' $ uc_price uc) +encodeUnderComp uc = appNull $ show' 1 <++> show' ( uc_conId uc ) + <++> show' ( uc_price uc) encodeComboLeg :: ComboLeg -> B.ByteString -encodeComboLeg cl = (show' $ cl_conId cl) - <++> (show' $ cl_ratio cl ) - <++> (B.pack $ cl_action cl ) - <++> (B.pack $ cl_exchange cl) +encodeComboLeg cl = appNull $ show' ( cl_conId cl) + <++> show' ( cl_ratio cl ) + <++> B.pack ( cl_action cl ) + <++> B.pack ( cl_exchange cl) encodeComboLegList :: [ComboLeg] -> B.ByteString -encodeComboLegList cll = (show' $ length cll) <++> (B.concat $ map encodeComboLeg cll ) +encodeComboLegList cll = appNull $ show' ( length cll) <++> B.concat ( map encodeComboLeg cll ) encodeContract :: IBServer -> Contract -> Bool -> IO B.ByteString encodeContract s con pexch = do let serv_ver = s_version s bs | serv_ver >= min_server_ver_trading_class = show' $ ct_conId con | otherwise = B.empty - out = bs <++> (B.pack $ ct_symbol con) - <++> (B.pack $ ct_secType con) - <++> (B.pack $ ct_expiry con) - <++> (show' $ ct_strike con) - <++> (B.pack $ ct_right con) - <++> (B.pack $ ct_multiplier con) - <++> (B.pack $ ct_exchange con) - out' | pexch = out <++> ( B.pack $ ct_primaryExchange con ) + out = bs <++> B.pack ( ct_symbol con) + <++> B.pack ( ct_secType con) + <++> B.pack ( ct_expiry con) + <++> show' ( ct_strike con) + <++> B.pack ( ct_right con) + <++> B.pack ( ct_multiplier con) + <++> B.pack ( ct_exchange con) + out' | pexch = out <++> B.pack ( ct_primaryExchange con ) | otherwise = out - out'' = out' <++> (B.pack $ ct_currency con) - <++> (B.pack $ ct_localSymbol con) + out'' = out' <++> B.pack ( ct_currency con) + <++> B.pack ( ct_localSymbol con) - if (serv_ver >= min_server_ver_trading_class) - then return $ out'' <++> (B.pack $ ct_tradingClass con) - else return out'' + if serv_ver >= min_server_ver_trading_class + then return $ appNull $ out'' <++> B.pack ( ct_tradingClass con) + else return $ appNull out'' getHeaderCon :: IBServer -> ReqHeader -> Contract -> IO B.ByteString getHeaderCon s rqh con = @@ -156,12 +167,12 @@ case () of _ | not connected -> throwIO $ IBExc (rqh_errId rqh) NotConnected "" - | rqh_minVer rqh /= undefined -> - if ((serv_ver < (rqh_minVer rqh)) && ((not $ null ( ct_tradingClass con)) || (ct_conId con) > 0)) - then throwIO $ IBExc (rqh_errId rqh) UpdateTWS (rqh_errMsg rqh) - else return () + | (rqh_minVer rqh) /= Nothing -> + when ((serv_ver < fromJust (rqh_minVer rqh)) && not ( null ( ct_tradingClass con)) || ct_conId con > 0) + $ throwIO $ IBExc (rqh_errId rqh) UpdateTWS (rqh_errMsg rqh) + | otherwise -> return () - return $ (show' $ rqh_msgId rqh) <++> (show' $ rqh_proVer rqh) + return $ appNull $ show' ( rqh_msgId rqh) <++> show' ( rqh_proVer rqh) getHeader :: IBServer -> ReqHeader -> IO B.ByteString getHeader s rqh = @@ -172,13 +183,13 @@ case () of _ | not connected -> throwIO $ IBExc (rqh_errId rqh) NotConnected "" - | rqh_minVer rqh /= undefined -> if (serv_ver < rqh_minVer rqh) then throwIO $ IBExc (rqh_errId rqh) UpdateTWS (rqh_errMsg rqh) - else return () - | rqh_exAuth rqh /= undefined -> if (not mExtraAuth) then throwIO $ IBExc (no_valid_id) UpdateTWS " Intent to authenticate needs to be expressed during initial connect request." - else return () + | (rqh_minVer rqh) /= Nothing -> when (serv_ver < fromJust (rqh_minVer rqh)) $ throwIO $ IBExc (rqh_errId rqh) UpdateTWS (rqh_errMsg rqh) - return $ (show' $ rqh_msgId rqh) <++> (show' $ rqh_proVer rqh) + | (rqh_exAuth rqh) /= Nothing -> unless mExtraAuth $ throwIO $ IBExc no_valid_id UpdateTWS " Intent to authenticate needs to be expressed during initial connect request." + | otherwise -> return () + return $ show' ( rqh_msgId rqh) <++> show' ( rqh_proVer rqh) + request :: IBServer -> Request -> IO () request s inp @ (MktDataReq { }) = @@ -192,28 +203,28 @@ case () of _ | not connected -> throwIO $ IBExc tickerId NotConnected "" - | (serv_ver < min_server_ver_under_comp) && (ct_underComp ct /= undefined) -> throwIO $ IBExc tickerId UpdateTWS " It does not support fundamental data requests." - | (serv_ver < min_server_ver_req_mkt_data_conid) && (ct_conId ct > 0) -> throwIO $ IBExc tickerId UpdateTWS " It does not support conId parameter." - | (serv_ver < min_server_ver_trading_class) && (not $ null (ct_tradingClass ct)) -> throwIO $ IBExc tickerId UpdateTWS " It does not support tradingClass parameter in reqMktData." + | serv_ver < min_server_ver_under_comp && (ct_underComp ct /= undefined) -> throwIO $ IBExc tickerId UpdateTWS " It does not support fundamental data requests." + | serv_ver < min_server_ver_req_mkt_data_conid && (ct_conId ct > 0) -> throwIO $ IBExc tickerId UpdateTWS " It does not support conId parameter." + | serv_ver < min_server_ver_trading_class && not ( null (ct_tradingClass ct)) -> throwIO $ IBExc tickerId UpdateTWS " It does not support tradingClass parameter in reqMktData." | otherwise -> return () - let bs = (show' (reqToId MktDataReq {})) - <++> (show' version) - <++> (show' tickerId) + let bs = show' (reqToId inp) + <++> show' version + <++> show' tickerId conbs | serv_ver >= min_server_ver_req_mkt_data_conid = show' $ ct_conId ct | otherwise = B.empty bs' = bs <++> conbs - <++> (B.pack $ ct_symbol ct ) - <++> (B.pack $ ct_secType ct) - <++> (B.pack $ ct_expiry ct) - <++> (show' $ ct_strike ct) - <++> (B.pack $ ct_right ct) - <++> (B.pack $ ct_multiplier ct ) - <++> (B.pack $ ct_exchange ct) - <++> (B.pack $ ct_primaryExchange ct) - <++> (B.pack $ ct_currency ct) - <++> (B.pack $ ct_localSymbol ct) + <++> B.pack ( ct_symbol ct ) + <++> B.pack ( ct_secType ct) + <++> B.pack ( ct_expiry ct) + <++> show' ( ct_strike ct) + <++> B.pack ( ct_right ct) + <++> B.pack ( ct_multiplier ct ) + <++> B.pack ( ct_exchange ct) + <++> B.pack ( ct_primaryExchange ct) + <++> B.pack ( ct_currency ct) + <++> B.pack ( ct_localSymbol ct) tclass | serv_ver >= min_server_ver_trading_class = (show' $ ct_tradingClass ct ) | otherwise = B.empty @@ -226,12 +237,12 @@ <++> tclass <++> clist <++> ucomp - <++> (B.pack $ mdr_genericTicks inp ) - <++> (show' $ fromBool ( mdr_snapshot inp)) + <++> B.pack ( mdr_genericTicks inp ) + <++> show' ( fromBool ( mdr_snapshot inp)) - if (serv_ver >= min_server_ver_linking) - then write s $ bs'' <++> ( encodeTagValueList $ mdr_mktDataOptions inp) - else write s bs'' + if serv_ver >= min_server_ver_linking + then write s $ appNull $ bs'' <++> encodeTagValueList ( mdr_mktDataOptions inp) + else write s $ appNull bs'' wFlush s @@ -240,7 +251,7 @@ , rqh_proVer = 2 , rqh_errId = tid } - write s $ hdr <++> show' tid + write s $ appNull $ hdr <++> show' tid wFlush s request s rq @ (PlaceOrder { rqp_orderId = oid }) = @@ -248,7 +259,7 @@ , rqh_proVer = 2 , rqh_errId = oid } - write s $ hdr <++> show' oid + write s $ appNull $ hdr <++> show' oid wFlush s -- TODO PlaceOrder Complete @@ -256,18 +267,18 @@ do hdr <- getHeader s defReqHeader { rqh_msgId = reqToId rq , rqh_errId = oid } - write s $ hdr <++> show' oid + write s $ appNull $ hdr <++> show' oid wFlush s -request s rq @ (OpenOrdersReq) = do hdr <- getHeader s defReqHeader { rqh_msgId = reqToId rq } - write s hdr - wFlush s +request s rq @ OpenOrdersReq = do hdr <- getHeader s defReqHeader { rqh_msgId = reqToId rq } + write s hdr + wFlush s request s rq @ (AccountUpdatesReq {aur_subscribe = subscribe, aur_acctCode = acctCode}) = do hdr <- getHeader s defReqHeader { rqh_msgId = reqToId rq , rqh_proVer = 2 } - write s $ (show' ( fromBool subscribe)) <++> B.pack acctCode + write s $ appNull $ show' ( fromBool subscribe) <++> B.pack acctCode wFlush s request s rq @ (ExecutionsReq req_id exc_filt) = @@ -278,11 +289,11 @@ reqbs | serv_ver >= min_server_ver_execution_data_chain = show' req_id | otherwise = B.empty - write s $ hdr <++> reqbs <++> encodeExecutionFilter exc_filt + write s $ appNull $ hdr <++> reqbs <++> encodeExecutionFilter exc_filt wFlush s request s rq @ (IdsReq numIds) = do hdr <- getHeader s defReqHeader { rqh_msgId = reqToId rq, rqh_errId = numIds } - write s $ hdr <++> show' numIds + write s $ appNull $ hdr <++> show' numIds wFlush s --TODO --request s rq @ (ContractDetailsReq req_id contract) = @@ -296,62 +307,61 @@ hdr <- getHeaderCon s defReqHeader { rqh_msgId = reqToId rq , rqh_proVer = 5 - , rqh_minVer = min_server_ver_trading_class + , rqh_minVer = Just min_server_ver_trading_class , rqh_errId = tid , rqh_errMsg = " It does not support conId and tradingClass parameters in reqMktDepth." } con con' <- encodeContract s con False - write s $ hdr <++> (show' tid) <++> con' <++> (show' numRows) + write s $ appNull $ hdr <++> show' tid <++> con' <++> show' numRows - if (serv_ver >= min_server_ver_linking) - then write s $ encodeTagValueList mkDepthOpts - else return () + when (serv_ver >= min_server_ver_linking) $ + write s $ appNull $ encodeTagValueList mkDepthOpts wFlush s request s rq @ (CancelMktDepth tid) = do hdr <- getHeader s defReqHeader { rqh_msgId = reqToId rq, rqh_errId = tid} - write s $ hdr <++> show' tid + write s $ appNull $ hdr <++> show' tid wFlush s request s rq @ (NewsBulletinsReq allMsgs) = do hdr <- getHeader s defReqHeader { rqh_msgId = reqToId rq} - write s $ hdr <++> show' ( fromBool allMsgs) + write s $ appNull $ hdr <++> show' ( fromBool allMsgs) wFlush s -request s rq @ (CancelNewsBulletins) = +request s rq @ CancelNewsBulletins = do hdr <- getHeader s defReqHeader { rqh_msgId = reqToId rq } - write s hdr + write s $ appNull hdr request s rq @ (SetServerLogLevel llvl) = do hdr <- getHeader s defReqHeader { rqh_msgId = reqToId rq } - write s $ hdr <++> show' llvl + write s $ appNull $ hdr <++> show' llvl wFlush s request s rq @ (AutoOpenOrdersReq autoBind) = do hdr <- getHeader s defReqHeader { rqh_msgId = reqToId rq } - write s $ hdr <++> show' (fromBool autoBind) + write s $ appNull $ hdr <++> show' (fromBool autoBind) wFlush s -request s rq @ (AllOpenOrdersReq) = +request s rq @ AllOpenOrdersReq = do hdr <- getHeader s defReqHeader { rqh_msgId = reqToId rq } - write s hdr + write s $ appNull hdr wFlush s -request s rq @ (ManagedAcctsReq) = +request s rq @ ManagedAcctsReq = do hdr <- getHeader s defReqHeader { rqh_msgId = reqToId rq } - write s hdr + write s $ appNull hdr wFlush s request s rq @ (FAReq fad) = do hdr <- getHeader s defReqHeader { rqh_msgId = reqToId rq} - write s $ hdr <++> show' ( fromEnum' fad) + write s $ appNull $ hdr <++> show' ( fromEnum' fad) request s rq @ (FAReplaceReq fad cxml) = do hdr <- getHeader s defReqHeader { rqh_msgId = reqToId rq} - write s $ hdr <++> show' (fromEnum' fad) <++> B.pack cxml + write s $ appNull $ hdr <++> show' (fromEnum' fad) <++> B.pack cxml wFlush s request s rq @ (HistoricalDataReq {rqp_tickerId = tid @@ -368,28 +378,26 @@ hdr <- getHeaderCon s defReqHeader { rqh_msgId = reqToId rq , rqh_proVer = 6 , rqh_errId = tid - , rqh_minVer = min_server_ver_trading_class + , rqh_minVer = Just min_server_ver_trading_class , rqh_errMsg = " It does not support conId and tradingClass parameters in reqHistoricalData." } con con' <- encodeContract s con True - write s $ (hdr <++> show' tid) + write s $ appNull $ (hdr <++> show' tid) <++> con' - <++> (show' $ fromBool $ ct_includeExpired con ) - <++> (B.pack edt) - <++> (B.pack barSizeSetting) - <++> (B.pack durStr) - <++> (show' useRTH) - <++> (B.pack whatToShow) - <++> (show' formatDate) + <++> show' ( fromBool $ ct_includeExpired con ) + <++> B.pack edt + <++> B.pack barSizeSetting + <++> B.pack durStr + <++> show' useRTH + <++> B.pack whatToShow + <++> show' formatDate - if (compare (ct_secType con) "BAG" == EQ) - then write s $ encodeComboLegList (ct_comboLegsList con) - else return () + when (compare (ct_secType con) "BAG" == EQ) $ + write s $ appNull $ encodeComboLegList (ct_comboLegsList con) - if (serv_ver >= min_server_ver_linking) - then write s $ encodeTagValueList chartOptions - else return () + when (serv_ver >= min_server_ver_linking) $ + write s $ appNull $ encodeTagValueList chartOptions wFlush s @@ -404,17 +412,17 @@ hdr <- getHeaderCon s defReqHeader { rqh_msgId = reqToId rq , rqh_proVer = 2 , rqh_errId = tid - , rqh_minVer = min_server_ver_trading_class + , rqh_minVer = Just min_server_ver_trading_class , rqh_errMsg = " It does not support conId and tradingClass parameters in reqHistoricalData." } con con' <- encodeContract s con False - write s $ hdr <++> show' tid + write s $ appNull $ hdr <++> show' tid <++> con' - <++> (show' exerciseAction) - <++> (show' exerciseQty) - <++> (B.pack account) - <++> (show' override ) + <++> show' exerciseAction + <++> show' exerciseQty + <++> B.pack account + <++> show' override wFlush s request s rq @ (ScannerSubscriptionReq { rqp_tickerId = tid @@ -426,11 +434,11 @@ , rqh_proVer = 4 , rqh_errId = tid } - write s $ show' tid <++> encodeSubscription subs + write s $ appNull $ show' tid <++> encodeSubscription subs - if (serv_ver >= min_server_ver_linking) - then write s $ encodeTagValueList subsOpts - else return () + when (serv_ver >= min_server_ver_linking) $ + write s $ appNull $ encodeTagValueList subsOpts + wFlush s @@ -438,50 +446,50 @@ do hdr <- getHeader s defReqHeader { rqh_msgId = reqToId rq , rqh_errId = tid } - write s $ hdr <++> show' tid + write s $ appNull $ hdr <++> show' tid wFlush s -- TODO: verify correctness -request s rq @ (ScannerParametersReq) = +request s rq @ ScannerParametersReq = do hdr <- getHeader s defReqHeader { rqh_msgId = reqToId rq } - write s $ hdr + write s $ appNull hdr wFlush s request s rq @ (CancelHistoricalData tid) = do hdr <- getHeader s defReqHeader { rqh_msgId = reqToId rq , rqh_errId = tid } - write s $ hdr <++> show' tid + write s $ appNull $ hdr <++> show' tid wFlush s -request s rq @ (CurrentTimeReq) = +request s rq @ CurrentTimeReq = do hdr <- getHeader s defReqHeader { rqh_msgId = reqToId rq } - write s hdr + write s $ appNull hdr wFlush s -- TODO needs dev -- request s rq @ (RealTimeBarsReq {}) = do hdr <- getHeader s defReqHeader { rqh_msgId = reqToId rq } - write s hdr + write s $ appNull hdr wFlush s request s rq @ (CancelRealTimeBars tid) = do hdr <- getHeader s defReqHeader { rqh_msgId = reqToId rq , rqh_errId = tid } - write s $ hdr <++> show' tid + write s $ appNull $ hdr <++> show' tid wFlush s request s rq @ (CancelFundamentalData tid) = do hdr <- getHeader s defReqHeader { rqh_msgId = reqToId rq , rqh_errId = tid - , rqh_minVer = min_server_ver_fundamental_data + , rqh_minVer = Just min_server_ver_fundamental_data , rqh_errMsg = " It does not support fundamental data requests." } - write s $ hdr <++> show' tid + write s $ appNull $ hdr <++> show' tid wFlush s --TODO @@ -490,112 +498,114 @@ request s rq @ (CancelCalcImpliedVolatility tid) = do hdr <- getHeader s defReqHeader { rqh_msgId = reqToId rq , rqh_errId = tid - , rqh_minVer = min_server_ver_cancel_calc_implied_volat + , rqh_minVer = Just min_server_ver_cancel_calc_implied_volat , rqh_errMsg = " It does not support calculate implied volatility cancellation." } - write s $ hdr <++> show' tid + write s $ appNull $ hdr <++> show' tid wFlush s request s rq @ (CancelCalcOptionPrice tid) = do hdr <- getHeader s defReqHeader { rqh_msgId = reqToId rq , rqh_errId = tid - , rqh_minVer = min_server_ver_cancel_calc_option_price + , rqh_minVer = Just min_server_ver_cancel_calc_option_price , rqh_errMsg = " It does not support calculate option price cancellation." } - write s $ hdr <++> show' tid + write s $ appNull $ hdr <++> show' tid wFlush s -request s rq @ (GlobalCancelReq) = +request s rq @ GlobalCancelReq = do hdr <- getHeader s defReqHeader { rqh_msgId = reqToId rq , rqh_errMsg = " It does not support globalCancel requests." - , rqh_minVer = min_server_ver_req_global_cancel + , rqh_minVer = Just min_server_ver_req_global_cancel } - write s $ hdr + write s $ appNull hdr wFlush s request s rq @ (MarketDataTypeReq tid) = do hdr <- getHeader s defReqHeader { rqh_msgId = reqToId rq} - write s $ hdr <++> show' tid + write s $ appNull $ hdr <++> show' tid wFlush s -request s rq @ (PositionsReq) = +request s rq @ PositionsReq = do hdr <- getHeader s defReqHeader { rqh_msgId = reqToId rq} - write s $ hdr + write s $ appNull hdr wFlush s --TODO --request s rq @ (AccountSummaryReq {}) = request s rq @ (CancelAccountSummary req_id) = do hdr <- getHeader s defReqHeader { rqh_msgId = reqToId rq - , rqh_minVer = min_server_ver_account_summary + , rqh_minVer = Just min_server_ver_account_summary , rqh_errMsg = " It does not support account summary cancellation." } - write s $ hdr + write s $ appNull hdr wFlush s -request s rq @ (CancelPositions) = +request s rq @ CancelPositions = do hdr <- getHeader s defReqHeader { rqh_msgId = reqToId rq , rqh_errMsg = " It does not support positions cancellation." - , rqh_minVer = min_server_ver_positions + , rqh_minVer = Just min_server_ver_positions } - write s $ hdr + write s $ appNull hdr wFlush s request s rq @ (VerifyReq apiName apiVersion) = do hdr <- getHeader s defReqHeader { rqh_msgId = reqToId rq - , rqh_minVer = min_server_ver_linking + , rqh_minVer = Just min_server_ver_linking , rqh_errMsg = " It does not support verification message sending." - , rqh_exAuth = True + , rqh_exAuth = Just True } - write s $ hdr <++> B.pack apiName <++> B.pack apiVersion + write s $ appNull $ hdr <++> B.pack apiName <++> B.pack apiVersion wFlush s request s rq @ (VerifyMessage apiData) = do hdr <- getHeader s defReqHeader { rqh_msgId = reqToId rq - , rqh_minVer = min_server_ver_linking + , rqh_minVer = Just min_server_ver_linking , rqh_errMsg = " It does not support verification message sending." } - write s $ hdr <++> B.pack apiData + write s $ appNull $ hdr <++> B.pack apiData wFlush s request s rq @ (QueryDisplayGroups rid) = do hdr <- getHeader s defReqHeader { rqh_msgId = reqToId rq - , rqh_minVer = min_server_ver_linking + , rqh_minVer = Just min_server_ver_linking , rqh_errMsg = " It does not support queryDisplayGroups request." } - write s $ hdr <++> show' rid + write s $ appNull $ hdr <++> show' rid wFlush s request s rq @ (SubscribeToGroupEvents reqId gid) = do hdr <- getHeader s defReqHeader { rqh_msgId = reqToId rq - , rqh_minVer = min_server_ver_linking + , rqh_minVer = Just min_server_ver_linking , rqh_errMsg = " It does not support subscribeToGroupEvents request." } - write s $ hdr <++> show' reqId + write s $ appNull $ hdr <++> show' reqId <++> show' gid + wFlush s request s rq @ (UpdateDisplayGroup reqId contractInfo) = do hdr <- getHeader s defReqHeader { rqh_msgId = reqToId rq - , rqh_minVer = min_server_ver_linking + , rqh_minVer = Just min_server_ver_linking , rqh_errMsg = " It does not support updateDisplayGroup request." } - write s $ show' reqId + write s $ appNull $ hdr <++> show' reqId <++> B.pack contractInfo + wFlush s request s rq @ (UnsubscribeFromGroupEvents reqId) = do hdr <- getHeader s defReqHeader { rqh_msgId = reqToId rq - , rqh_minVer = min_server_ver_linking + , rqh_minVer = Just min_server_ver_linking , rqh_errMsg = " It does not support unsubscribeFromGroupEvents request." } - write s $ hdr <++> show' reqId + write s $ appNull $ hdr <++> show' reqId wFlush s -request s rq @ (StartApi) = +request s rq @ StartApi = do let clientId = s_clientId s hdr <- getHeader s defReqHeader { rqh_msgId = reqToId rq } - write s $ hdr <++> show' clientId + write s $ appNull $ hdr <++> show' clientId wFlush s diff --git a/src/IB/Client/Types.hs b/src/IB/Client/Types.hs --- a/src/IB/Client/Types.hs +++ b/src/IB/Client/Types.hs @@ -1,5 +1,5 @@ {-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE BangPatterns #-} +--{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveDataTypeable #-} module IB.Client.Types where @@ -113,6 +113,7 @@ | CancelCalcOptionPrice TickerId | GlobalCancelReq | MarketDataTypeReq TickerId + | UnusedReq | PositionsReq | AccountSummaryReq { rqp_reqId :: ReqId @@ -194,7 +195,6 @@ | ContractData ContractDetails | ExecutionData { reqId :: Int - , orderId :: Int , contract :: Contract , exec :: Execution } @@ -271,6 +271,7 @@ , dividendImpact :: Double , dividendsToExpiry :: Double } + | UnusedMsg1 | CurrentTime Int | RealTimeBars { reqId :: Int @@ -308,6 +309,7 @@ , yield :: Double , yieldRedemptionDate :: Int } + | UnusedMsg2 | PositionData { account :: String , contract :: Contract @@ -337,7 +339,7 @@ , contractInfo :: String } | IBUnknown - deriving (Typeable, Data) + deriving (Typeable, Data, Show) data RecvMsg = RecvMsg @@ -363,7 +365,7 @@ , s_extraAuth :: Bool , s_version :: Int , s_connected :: Bool - , s_twsTime :: Int + , s_twsTime :: String , s_debug :: Bool , s_sock :: Maybe Handle , s_msgThread :: Maybe ThreadId @@ -462,7 +464,7 @@ | otherwise = inp dblDefaultCheck :: Double -> Double -dblDefaultCheck inp = dblBoundsCheck 1.0 (-1.0) inp +dblDefaultCheck = dblBoundsCheck 1.0 (-1.0) dblBoundsCheck :: Double -> Double -> Double -> Double dblBoundsCheck upperBounds lowerBounds inp @@ -470,7 +472,7 @@ | otherwise = inp fromEnum' :: Enum a => a -> Int -fromEnum' a = (fromEnum a) +1 +fromEnum' a = fromEnum a +1 fromBool :: Num a => Bool -> a fromBool False = 0 @@ -483,18 +485,21 @@ conToId = constrIndex . toConstr msgToId :: IBMessage -> Int -msgToId = conToId +msgToId msg | (conToId msg) > 21 = conToId msg + 23 +msgToId msg | otherwise = conToId msg reqToId :: Request -> Int -reqToId = conToId +reqToId rq | (conToId rq) > 25 = conToId rq + 23 +reqToId rq | otherwise = conToId rq idToMsg :: Int -> IBMessage -idToMsg = fromConstr . indexConstr (dataTypeOf IBUnknown) +idToMsg id | id > 25 = fromConstr $ indexConstr (dataTypeOf IBUnknown) (id - 23) +idToMsg id | otherwise = fromConstr $ indexConstr (dataTypeOf IBUnknown) id data Preamble = Preamble { pre_serverVersion :: Int - , pre_twsTime :: Int + , pre_twsTime :: String } data Execution = @@ -515,7 +520,7 @@ , ex_orderRef :: String , ex_evRule :: String , ex_evMultiplier :: Double - } deriving (Data, Typeable) + } deriving (Data, Typeable, Show) data ExecutionFilter = ExecutionFilter @@ -539,7 +544,7 @@ , bar_average :: Double , bar_hasGaps :: String , bar_barCount :: Int - } deriving (Typeable, Data) + } deriving (Typeable, Data, Show) data ScanData = ScanData @@ -549,7 +554,7 @@ , sd_benchmark :: String , sd_projection :: String , sd_legsStr :: String - } deriving (Typeable, Data) + } deriving (Typeable, Data, Show) data OrderState = OrderState @@ -562,13 +567,13 @@ , os_maxCommission :: Double , os_commissionCurrency :: String , os_warningText :: String - } deriving (Typeable, Data) + } deriving (Typeable, Data, Show) data TagValue = TagValue { tv_tag :: String , tv_value :: String - } deriving (Typeable, Data) + } deriving (Typeable, Data, Show) data ScannerSubscription = @@ -628,15 +633,23 @@ , cl_shortSaleSlot :: Int -- 1 = clearing broker, 2 = third party , cl_designatedLocation :: String , cl_exemptCode :: Int - } deriving (Typeable, Data) + } deriving (Typeable, Data, Show) data UnderComp = UnderComp { uc_conId :: Int , uc_delta :: Double , uc_price :: Double - } deriving (Typeable, Data, Eq) + } deriving (Typeable, Data, Eq, Show) +defUnderComp :: UnderComp +defUnderComp = + UnderComp + { uc_conId = 0 + , uc_delta = 0.0 + , uc_price = 0.0 + } + data Contract = Contract { ct_conId :: Int @@ -666,8 +679,31 @@ -- delta neutral , ct_underComp :: UnderComp - } deriving (Typeable, Data) + } deriving (Typeable, Data, Show) +defContract :: Contract +defContract = + Contract + { ct_conId = 0 + , ct_symbol = "" + , ct_secType= "" + , ct_expiry = "" + , ct_strike = 0.0 + , ct_right = "" + , ct_multiplier = "" + , ct_exchange = "" + , ct_primaryExchange= "" + , ct_currency = "" + , ct_localSymbol = "" + , ct_tradingClass = "" + , ct_includeExpired = False + , ct_secIdType = "" + , ct_secId= "" + , ct_comboLegsDescrip= "" + , ct_comboLegsList = [] + , ct_underComp = defUnderComp + } + data ContractDetails = ContractDetails { ctd_summary :: Contract @@ -704,8 +740,46 @@ , ctd_nextOptionType :: String , ctd_nextOptionPartial :: Bool , ctd_notes :: String - } deriving (Data, Typeable) + } deriving (Data, Typeable, Show) +defContractDetails :: ContractDetails +defContractDetails = + ContractDetails + { ctd_summary = defContract + , ctd_marketName = "" + , ctd_minTick = 0.0 + , ctd_orderTypes = "" + , ctd_validExchanges = "" + , ctd_priceMagnifier = 0 + , ctd_underConId = int32max + , ctd_longName = "" + , ctd_contractMonth = "" + , ctd_industry = "" + , ctd_category = "" + , ctd_subcategory = "" + , ctd_timeZoneId = "" + , ctd_tradingHours = "" + , ctd_liquidHours = "" + , ctd_evRule = "" + , ctd_evMultiplier = dblMaximum + , ctd_secIdList = [] + , ctd_cusip = "" + , ctd_ratings = "" + , ctd_descAppend = "" + , ctd_bondType = "" + , ctd_couponType = "" + , ctd_callable = False + , ctd_putable = False + , ctd_coupon = 0.0 + , ctd_convertible = False + , ctd_maturity = "" + , ctd_issueDate = "" + , ctd_nextOptionDate = "" + , ctd_nextOptionType = "" + , ctd_nextOptionPartial = False + , ctd_notes = "" + } + data Order = Order { ord_orderId :: Int @@ -804,7 +878,7 @@ , ord_settlingFirm :: String , ord_clearingAccount :: String -- True beneficiary of the order , ord_clearingIntent :: String -- "" (Default), "IB", "Away", "PTA" (PostTrade) - , ord_-- ALGO ORDERS ONLY + -- ALGO ORDERS ONLY , ord_algoStrategy :: String , ord_algoParams :: [TagValue] , ord_smartComboRoutingParams :: [TagValue] @@ -819,6 +893,99 @@ -- --orderComboLegs OrderComboLegListSPtr --orderMiscOptions TagValueListSPtr - } deriving (Data, Typeable) + } deriving (Data, Typeable, Show) +defOrder :: Order +defOrder = + Order + { ord_orderId = 0 + , ord_clientId = 0 + , ord_permId = 0 + , ord_action = "" + , ord_totalQuantity = 0 + , ord_orderType = "" + , ord_lmtPrice = dblMaximum + , ord_auxPrice = dblMaximum + , ord_tif = "" + , ord_activeStartTime = "" + , ord_activeStopTime = "" + , ord_ocaGroup = "" + , ord_ocaType = 0 + , ord_orderRef = "" + , ord_transmit = True + , ord_parentId = 0 + , ord_blockOrder = False + , ord_sweepToFill = False + , ord_displaySize = 0 + , ord_triggerMethod = 0 + , ord_outsideRth = False + , ord_hidden = False + , ord_goodAfterTime = "" + , ord_goodTillDate = "" + , ord_rule80A = "" + , ord_allOrNone = False + , ord_minQty = int32max + , ord_percentOffset = dblMaximum + , ord_overridePercentageConstraints = False + , ord_trailStopPrice = dblMaximum + , ord_trailingPercent = dblMaximum + , ord_faGroup = "" + , ord_faProfile = "" + , ord_faMethod = "" + , ord_faPercentage = "" + , ord_openClose = "O" + , ord_origin = CUSTOMER + , ord_shortSaleSlot = 0 + , ord_designatedLocation = "" + , ord_exemptCode = -1 + , ord_discretionaryAmt = 0 + , ord_eTradeOnly = True + , ord_firmQuoteOnly = True + , ord_nbboPriceCap = dblMaximum + , ord_optOutSmartRouting = False + , ord_auctionStrategy = 0 + , ord_startingPrice = dblMaximum + , ord_stockRefPrice = dblMaximum + , ord_delta = dblMaximum + , ord_stockRangeLower = dblMaximum + , ord_stockRangeUpper = dblMaximum + , ord_volatility = dblMaximum + , ord_volatilityType = int32max + , ord_deltaNeutralOrderType = "" + , ord_deltaNeutralAuxPrice = dblMaximum + , ord_deltaNeutralConId = 0 + , ord_deltaNeutralSettlingFirm = "" + , ord_deltaNeutralClearingAccount = "" + , ord_deltaNeutralClearingIntent = "" + , ord_deltaNeutralOpenClose = "" + , ord_deltaNeutralShortSale = False + , ord_deltaNeutralShortSaleSlot = 0 + , ord_deltaNeutralDesignatedLocation = "" + , ord_continuousUpdate = False + , ord_referencePriceType = int32max + , ord_basisPoints = dblMaximum + , ord_basisPointsType = int32max + , ord_scaleInitLevelSize = int32max + , ord_scaleSubsLevelSize = int32max + , ord_scalePriceIncrement = dblMaximum + , ord_scalePriceAdjustValue = dblMaximum + , ord_scalePriceAdjustInterval = int32max + , ord_scaleProfitOffset = dblMaximum + , ord_scaleAutoReset = False + , ord_scaleInitPosition = int32max + , ord_scaleInitFillQty = int32max + , ord_scaleRandomPercent = False + , ord_scaleTable = "" + , ord_hedgeType = "" + , ord_hedgeParam = "" + , ord_account = "" + , ord_settlingFirm = "" + , ord_clearingAccount = "" + , ord_clearingIntent = "" + , ord_algoStrategy = "" + , ord_algoParams = [] + , ord_smartComboRoutingParams = [] + , ord_whatIf = False + , ord_notHeld = False + }