ib-api 0.1.0.0 → 0.1.0.1
raw patch · 7 files changed
+880/−672 lines, 7 filesdep +ib-apidep +unixnew-component:exe:ex
Dependencies added: ib-api, unix
Files
- ex/Main.hs +83/−0
- ib-api.cabal +15/−2
- src/Examples/Example.hs +0/−34
- src/IB/Client.hs +44/−37
- src/IB/Client/Parser.hs +361/−399
- src/IB/Client/Request.hs +189/−179
- src/IB/Client/Types.hs +188/−21
+ ex/Main.hs view
@@ -0,0 +1,83 @@+-- |+-- Module : IB.Client+-- License : GPL3+-- Author : Robert Bermani <bobbermani@gmail.com>+-- 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
ib-api.cabal view
@@ -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
− src/Examples/Example.hs
@@ -1,34 +0,0 @@--- |--- Module : IB.Client--- License : GPL3--- Author : Robert Bermani <bobbermani@gmail.com>--- 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 = ---}
src/IB/Client.hs view
@@ -3,7 +3,6 @@ -- License : GPL3 -- Author : Robert Bermani <bobbermani@gmail.com> -- 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 }
src/IB/Client/Parser.hs view
@@ -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
src/IB/Client/Request.hs view
@@ -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
src/IB/Client/Types.hs view
@@ -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+ }