Init
This commit is contained in:
Stefan Dresselhaus
95
src/IBClient/Connection.hs
Normal file
95
src/IBClient/Connection.hs
Normal file
@ -0,0 +1,95 @@
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
module IBClient.Connection where
|
||||
|
||||
import Import
|
||||
|
||||
import Data.Binary
|
||||
import Network.Socket
|
||||
import Network.Socket.ByteString
|
||||
|
||||
import qualified Control.Exception as E
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
import qualified Data.ByteString.Char8 as BS8
|
||||
import qualified Data.Text as T
|
||||
|
||||
forkClient :: App -> IO ()
|
||||
forkClient app = runRIO app $ withRunInIO $ \run -> withSocketsDo $ do
|
||||
let refs = twsConnectionRefs $ appRefs app
|
||||
toSend = twsConnectionSend refs
|
||||
toRecieve = twsConnectionRecieve refs
|
||||
cStatus = twsConnectionStatus refs
|
||||
debugSend x = run $ logDebug (display $ T.pack $ "SENT : " <> show x)
|
||||
debugRecv x = run $ logDebug (display $ T.pack $ "RECIEVED: " <> show x)
|
||||
connHost <- readTVarIO $ twsConnectionRefsHost refs
|
||||
connPort <- readTVarIO $ twsConnectionRefsPort refs
|
||||
atomically $ modifyTVar' cStatus (const TWSConnecting)
|
||||
-- TODO: throws IO-Exeption instead of returning empty list -> handle!
|
||||
addr:_ <- getAddrInfo (Just $ defaultHints { addrFlags = [AI_NUMERICHOST, AI_NUMERICSERV], addrProtocol = 0, addrSocketType = Stream}) (Just connHost) (Just connPort)
|
||||
run $ logDebug $ displayShow addr
|
||||
E.bracketOnError (socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)) close $ \sock -> do
|
||||
connect sock $ addrAddress addr
|
||||
let connStr = BS8.pack "API\0\0\0\0\tv100..157"
|
||||
sendAll sock connStr
|
||||
debugSend connStr
|
||||
answer <- recvAll sock
|
||||
run $ logDebug (displayShow (decode . LBS.fromStrict <$> answer :: Maybe IBGenericMessage))
|
||||
-- if we have the answer we are connected
|
||||
let idStr = LBS.toStrict $ encode $ IB_StartAPI "2" "69" -- version 2, client-id: 69
|
||||
sendAll sock idStr
|
||||
debugSend idStr
|
||||
atomically $ modifyTVar' cStatus (const TWSConnected)
|
||||
run $ logInfo $ display ("Connected to TWS" :: Text)
|
||||
let go True = do
|
||||
-- abort connection, close everything
|
||||
return ()
|
||||
go False = do
|
||||
-- race: wait for MSG in Queue or for answer on socket
|
||||
input <- race (atomically $ readTQueue toSend)
|
||||
(recvAll sock)
|
||||
case input of
|
||||
-- we want to disconnect
|
||||
Left IBDisconnect -> go True
|
||||
Left (Msg_IB_OUT x) -> do
|
||||
let msg = LBS.toStrict $ encode x
|
||||
debugSend msg
|
||||
sendAll sock msg
|
||||
-- we lost connection
|
||||
Right Nothing -> do
|
||||
atomically $ do
|
||||
writeTQueue toRecieve IBServerGone
|
||||
modifyTVar' cStatus (const TWSDisconnected)
|
||||
run $ logWarn $ display $ T.pack "Lost connection to TWS, reconnecting..."
|
||||
forkClient app
|
||||
Right (Just x) -> do debugRecv x
|
||||
parseMessage x
|
||||
where
|
||||
parseMessage "" = return ()
|
||||
parseMessage m = do
|
||||
let d = decodeOrFail @IB_IN (LBS.fromStrict m)
|
||||
case d of
|
||||
Right (rest, offset, result) -> do
|
||||
atomically $ writeTQueue toRecieve (Msg_IB_IN result)
|
||||
parseMessage (LBS.toStrict rest)
|
||||
Left (rest, offset, err) -> do
|
||||
run $ logInfo (display $ T.pack $ "Could not understand message: "<> ppShow err <> " ... skipping.\nRAW: " <> show m)
|
||||
if m == "\NUL" then do
|
||||
run $ logInfo (display $ T.pack "killing NUL")
|
||||
parseMessage (LBS.toStrict $ LBS.tail rest)
|
||||
else
|
||||
parseMessage (LBS.toStrict rest)
|
||||
go False
|
||||
go False
|
||||
|
||||
|
||||
recvAll :: Socket -> IO (Maybe ByteString)
|
||||
recvAll s = do
|
||||
d <- recv s 4096
|
||||
let l = BS.length d
|
||||
if
|
||||
| l == 0 -> return Nothing
|
||||
| l < 4096 -> return $ Just d
|
||||
| l == 4096 -> do
|
||||
next <- recvAll s
|
||||
return $ (d<>) <$> next
|
||||
| otherwise -> error "recvAll: recv got more bytes then requested. Impossible according to RFC"
|
||||
581
src/IBClient/Types.hs
Normal file
581
src/IBClient/Types.hs
Normal file
@ -0,0 +1,581 @@
|
||||
{-# HLINT ignore "Use camelCase" #-}
|
||||
{-# LANGUAGE DerivingStrategies #-}
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# OPTIONS_GHC -Wno-partial-fields #-}
|
||||
module IBClient.Types where
|
||||
|
||||
import Data.Binary
|
||||
import Data.Binary.Get
|
||||
import Data.Binary.Put
|
||||
import Data.Text.Encoding
|
||||
import Data.Maybe
|
||||
import Data.Default
|
||||
import Data.Aeson (FromJSON, ToJSON)
|
||||
import GHC.Enum (Enum(..))
|
||||
import RIO
|
||||
import RIO.List
|
||||
import RIO.List.Partial
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.ByteString.Char8 as BS8
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
import qualified Data.ByteString.Lazy.Char8 as LBS8
|
||||
|
||||
|
||||
import qualified Debug.Trace as D
|
||||
|
||||
data Msg_IB_OUT = IBDisconnect
|
||||
| Msg_IB_OUT IB_OUT
|
||||
deriving (Show, Eq)
|
||||
|
||||
data Msg_IB_IN = IBServerGone
|
||||
| Msg_IB_IN IB_IN
|
||||
deriving (Show, Eq)
|
||||
|
||||
data IBTypes = IBString ByteString
|
||||
| IBBool Bool
|
||||
| IBArray [ByteString]
|
||||
deriving (Show, Eq)
|
||||
|
||||
toBS :: IBTypes -> ByteString
|
||||
toBS (IBString t) = t
|
||||
toBS (IBArray a) = (BS8.pack . show . length $ a) <> BS.intercalate "\0" a <> "\0"
|
||||
toBS (IBBool True) = "1"--BS.pack [0,0,0,1] -- bool == 32-bit int in IB
|
||||
toBS (IBBool False) = "0"--BS.pack [0,0,0,0] -- bool == 32-bit int in IB
|
||||
|
||||
newtype IBGenericMessage = IBGenericMessage
|
||||
{ fields :: [IBTypes]
|
||||
} deriving (Show, Eq)
|
||||
|
||||
instance Binary IBGenericMessage where
|
||||
put (IBGenericMessage f) = do
|
||||
let msg = BS.intercalate "\0" (toBS <$> f) <> "\0"
|
||||
putWord32be . fromIntegral . BS.length $ msg
|
||||
putByteString msg
|
||||
get = do
|
||||
len <- getWord32be
|
||||
D.traceShow len $ return ()
|
||||
fields <- BS.split 0 . BS.init <$> getByteString (fromIntegral len)
|
||||
D.traceShow fields $ return ()
|
||||
return $ IBGenericMessage $ IBString <$> fields
|
||||
|
||||
data IB_OUT = IB_StartAPI { version :: Text, clientId :: Text }
|
||||
| IB_RequestPositions
|
||||
| IB_RequestAccountData { subscribe :: Bool, acctCode :: Text }
|
||||
| IB_RequestMatchingSymbol { reqId :: Int, symbol :: Text }
|
||||
| IB_RequestMarketDataType { dataType :: IBMarketDataType }
|
||||
| IB_RequestMktData { tickerId :: Int, contract :: IBContract, genericTickList :: Text, snapshot :: Bool, regulatorySnapshot :: Bool }
|
||||
deriving (Show, Eq)
|
||||
|
||||
tToIB :: Text -> IBTypes
|
||||
tToIB = IBString . encodeUtf8
|
||||
|
||||
iToIB :: Int -> IBTypes
|
||||
iToIB = IBString . BS8.pack . show
|
||||
|
||||
fToIB :: Float -> IBTypes
|
||||
fToIB = IBString . BS8.pack . show
|
||||
|
||||
clToIB :: [IBComboLeg] -> [IBTypes]
|
||||
clToIB as = iToIB (length as) : concatMap (\IBComboLeg{..} -> [iToIB conId, iToIB ratio, tToIB action, tToIB exchange]) as
|
||||
|
||||
dncToIB :: Maybe IBDeltaNeutralContract -> [IBTypes]
|
||||
dncToIB Nothing = []
|
||||
dncToIB (Just IBDeltaNeutralContract{..}) = [iToIB 1, iToIB conId, fToIB delta, fToIB price]
|
||||
|
||||
instance Binary IB_OUT where
|
||||
put (IB_StartAPI v c) = put (IBGenericMessage [IBString "71", tToIB v, tToIB c, IBString ""])
|
||||
put IB_RequestPositions = put (IBGenericMessage [IBString "61", IBString "v"])
|
||||
put (IB_RequestAccountData s a) = put (IBGenericMessage [IBString "6", IBString "2", IBBool s, tToIB a])
|
||||
put (IB_RequestMatchingSymbol i s) = put (IBGenericMessage [IBString "81", iToIB i, tToIB s])
|
||||
put (IB_RequestMktData t IBContract{..} l s r) = put $ D.traceShowId (IBGenericMessage $ [IBString "1", IBString "11", iToIB t, iToIB conId, tToIB symbol, tToIB secType, tToIB lastTradeDate, fToIB strike, tToIB right, tToIB multiplier, tToIB exchange, tToIB primaryExchange, tToIB currency, tToIB localSymbol, tToIB tradingClass] <> clToIB comboLegs <> dncToIB deltaNeutralContract <> [tToIB l, iToIB (if s then 1 else 0), iToIB (if r then 1 else 0), tToIB ""])
|
||||
put (IB_RequestMarketDataType t) = put (IBGenericMessage [IBString "59", IBString "1", iToIB $ fromEnum t])
|
||||
|
||||
get = do f <- fmap (\(IBString x) -> x) . fields <$> get
|
||||
case headMaybe f of
|
||||
Just "71" -> return $ IB_StartAPI (decodeUtf8 $ f!!1) (decodeUtf8 $ f!!2)
|
||||
Just "6" -> return $ IB_RequestAccountData {- ignore version -} (all (==0) . BS.unpack $ f!!2) (decodeUtf8 $ f!!3)
|
||||
Just "59" -> return $ IB_RequestMarketDataType {- ignore version -} (toEnum . fromJust . readMaybe . BS8.unpack $ f!!2)
|
||||
Just x -> fail $ "unkonwn IB_OUT type" <> BS8.unpack x
|
||||
Nothing -> fail $ "No Fields"
|
||||
|
||||
data IBContract = IBContract
|
||||
{ conId :: Int
|
||||
, symbol :: Text
|
||||
, secType :: Text
|
||||
, lastTradeDate :: Text
|
||||
, strike :: Float
|
||||
, right :: Text
|
||||
, multiplier :: Text
|
||||
, exchange :: Text -- ^ can be SMART
|
||||
, primaryExchange :: Text -- ^ actual exchange - MUST NOT BE SMART
|
||||
, currency :: Text
|
||||
, localSymbol :: Text
|
||||
, tradingClass :: Text
|
||||
, includeExpired :: Bool
|
||||
, secIdType :: Text
|
||||
, secId :: Text
|
||||
, comboLegsDescrip :: Text -- ^ received in open order 14 and up for all combos
|
||||
, comboLegs :: [IBComboLeg]
|
||||
, deltaNeutralContract :: Maybe IBDeltaNeutralContract
|
||||
} deriving (Show, Eq, Generic)
|
||||
deriving anyclass (FromJSON, ToJSON)
|
||||
|
||||
instance Default IBContract where
|
||||
def = IBContract 0 "" "" "" 0 "" "" "" "" "" "" "" False "" "" "" [] Nothing
|
||||
|
||||
data IBComboLeg = IBComboLeg
|
||||
{ conId :: Int
|
||||
, ratio :: Int
|
||||
, action :: Text -- ^ BUY/SELL/SSHORT
|
||||
, exchange :: Text
|
||||
, openClose :: Int -- ^ LegOpenClose enum values
|
||||
, shortSaleSlot :: Int
|
||||
, designatedLocation :: Text
|
||||
, exemptCode :: Int
|
||||
} deriving (Show, Eq, Generic)
|
||||
deriving anyclass (FromJSON, ToJSON)
|
||||
|
||||
instance Default IBComboLeg where
|
||||
def = IBComboLeg 0 0 "" "" 0 0 "" (negate 1)
|
||||
|
||||
data IBDeltaNeutralContract = IBDeltaNeutralContract
|
||||
{ conId :: Int
|
||||
, delta :: Float
|
||||
, price :: Float
|
||||
} deriving (Show, Eq, Generic)
|
||||
deriving anyclass (FromJSON, ToJSON)
|
||||
|
||||
instance Default IBDeltaNeutralContract where
|
||||
def = IBDeltaNeutralContract 0 0 0
|
||||
|
||||
data IBMarketDataType = RealTime
|
||||
| Frozen
|
||||
| Delayed
|
||||
| DelayedFrozen
|
||||
deriving (Show, Eq, Generic)
|
||||
deriving anyclass (FromJSON, ToJSON)
|
||||
|
||||
instance Default IBMarketDataType where
|
||||
def = DelayedFrozen
|
||||
|
||||
instance Enum IBMarketDataType where
|
||||
toEnum 1 = RealTime
|
||||
toEnum 2 = Frozen
|
||||
toEnum 3 = Delayed
|
||||
toEnum 4 = DelayedFrozen
|
||||
toEnum _ = def
|
||||
fromEnum RealTime = 1
|
||||
fromEnum Frozen = 2
|
||||
fromEnum Delayed = 3
|
||||
fromEnum DelayedFrozen = 4
|
||||
|
||||
data IBTickType = Unknown Int
|
||||
| IBTickType_Bid_Size
|
||||
| IBTickType_Bid_Price
|
||||
| IBTickType_Ask_Price
|
||||
| IBTickType_Ask_Size
|
||||
| IBTickType_Last_Price
|
||||
| IBTickType_Last_Size
|
||||
| IBTickType_High
|
||||
| IBTickType_Low
|
||||
| IBTickType_Volume
|
||||
| IBTickType_Close_Price
|
||||
| IBTickType_Bid_Option_Computation
|
||||
| IBTickType_Ask_Option_Computation
|
||||
| IBTickType_Last_Option_Computation
|
||||
| IBTickType_Model_Option_Computation
|
||||
| IBTickType_Open_Tick
|
||||
| IBTickType_Low_13_Weeks
|
||||
| IBTickType_High_13_Weeks
|
||||
| IBTickType_Low_26_Weeks
|
||||
| IBTickType_High_26_Weeks
|
||||
| IBTickType_Low_52_Weeks
|
||||
| IBTickType_High_52_Weeks
|
||||
| IBTickType_Average_Volume
|
||||
| IBTickType_Open_Interest
|
||||
| IBTickType_Option_Historical_Volatility
|
||||
| IBTickType_Option_Implied_Volatility
|
||||
| IBTickType_Option_Bid_Exchange
|
||||
| IBTickType_Option_Ask_Exchange
|
||||
| IBTickType_Option_Call_Open_Interest
|
||||
| IBTickType_Option_Put_Open_Interest
|
||||
| IBTickType_Option_Call_Volume
|
||||
| IBTickType_Option_Put_Volume
|
||||
| IBTickType_Index_Future_Premium
|
||||
| IBTickType_Bid_Exchange
|
||||
| IBTickType_Ask_Exchange
|
||||
| IBTickType_Auction_Volume
|
||||
| IBTickType_Auction_Price
|
||||
| IBTickType_Auction_Imbalance
|
||||
| IBTickType_Mark_Price
|
||||
| IBTickType_Bid_EFP_Computation
|
||||
| IBTickType_Ask_EFP_Computation
|
||||
| IBTickType_Last_EFP_Computation
|
||||
| IBTickType_Open_EFP_Computation
|
||||
| IBTickType_High_EFP_Computation
|
||||
| IBTickType_Low_EFP_Computation
|
||||
| IBTickType_Close_EFP_Computation
|
||||
| IBTickType_Last_Timestamp
|
||||
| IBTickType_Shortable
|
||||
| IBTickType_RT_Volume
|
||||
| IBTickType_Halted
|
||||
| IBTickType_Bid_Yield
|
||||
| IBTickType_Ask_Yield
|
||||
| IBTickType_Last_Yield
|
||||
| IBTickType_Custom_Option_Computation
|
||||
| IBTickType_Trade_Count
|
||||
| IBTickType_Trade_Rate
|
||||
| IBTickType_Volume_Rate
|
||||
| IBTickType_Last_RTH_Trade
|
||||
| IBTickType_RT_Historical_Volatility
|
||||
| IBTickType_IB_Dividends
|
||||
| IBTickType_Bond_Factor_Multiplier
|
||||
| IBTickType_Regulatory_Imbalance
|
||||
| IBTickType_News
|
||||
| IBTickType_ShortTerm_Volume_3_Minutes
|
||||
| IBTickType_ShortTerm_Volume_5_Minutes
|
||||
| IBTickType_ShortTerm_Volume_10_Minutes
|
||||
| IBTickType_Delayed_Bid
|
||||
| IBTickType_Delayed_Ask
|
||||
| IBTickType_Delayed_Last
|
||||
| IBTickType_Delayed_Bid_Size
|
||||
| IBTickType_Delayed_Ask_Size
|
||||
| IBTickType_Delayed_Last_Size
|
||||
| IBTickType_Delayed_High_Price
|
||||
| IBTickType_Delayed_Low_Price
|
||||
| IBTickType_Delayed_Volume
|
||||
| IBTickType_Delayed_Close
|
||||
| IBTickType_Delayed_Open
|
||||
| IBTickType_RT_Trade_Volume
|
||||
| IBTickType_Creditman_mark_price
|
||||
| IBTickType_Creditman_slow_mark_price
|
||||
| IBTickType_Delayed_Bid_Option
|
||||
| IBTickType_Delayed_Ask_Option
|
||||
| IBTickType_Delayed_Last_Option
|
||||
| IBTickType_Delayed_Model_Option
|
||||
| IBTickType_Last_Exchange
|
||||
| IBTickType_Last_Regulatory_Time
|
||||
| IBTickType_Futures_Open_Interest
|
||||
| IBTickType_Average_Option_Volume
|
||||
| IBTickType_Delayed_Last_Timestamp
|
||||
| IBTickType_Shortable_Shares
|
||||
| IBTickType_ETF_Nav_Close
|
||||
| IBTickType_ETF_Nav_Prior_Close
|
||||
| IBTickType_ETF_Nav_Bid
|
||||
| IBTickType_ETF_Nav_Ask
|
||||
| IBTickType_ETF_Nav_Last
|
||||
| IBTickType_ETF_Nav_Frozen_Last
|
||||
| IBTickType_ETF_Nav_High
|
||||
| IBTickType_ETF_Nav_Low
|
||||
deriving (Show, Eq)
|
||||
|
||||
instance Enum IBTickType where
|
||||
toEnum 0 = IBTickType_Bid_Size
|
||||
toEnum 1 = IBTickType_Bid_Price
|
||||
toEnum 2 = IBTickType_Ask_Price
|
||||
toEnum 3 = IBTickType_Ask_Size
|
||||
toEnum 4 = IBTickType_Last_Price
|
||||
toEnum 5 = IBTickType_Last_Size
|
||||
toEnum 6 = IBTickType_High
|
||||
toEnum 7 = IBTickType_Low
|
||||
toEnum 8 = IBTickType_Volume
|
||||
toEnum 9 = IBTickType_Close_Price
|
||||
toEnum 10 = IBTickType_Bid_Option_Computation
|
||||
toEnum 11 = IBTickType_Ask_Option_Computation
|
||||
toEnum 12 = IBTickType_Last_Option_Computation
|
||||
toEnum 13 = IBTickType_Model_Option_Computation
|
||||
toEnum 14 = IBTickType_Open_Tick
|
||||
toEnum 15 = IBTickType_Low_13_Weeks
|
||||
toEnum 16 = IBTickType_High_13_Weeks
|
||||
toEnum 17 = IBTickType_Low_26_Weeks
|
||||
toEnum 18 = IBTickType_High_26_Weeks
|
||||
toEnum 19 = IBTickType_Low_52_Weeks
|
||||
toEnum 20 = IBTickType_High_52_Weeks
|
||||
toEnum 21 = IBTickType_Average_Volume
|
||||
toEnum 22 = IBTickType_Open_Interest
|
||||
toEnum 23 = IBTickType_Option_Historical_Volatility
|
||||
toEnum 24 = IBTickType_Option_Implied_Volatility
|
||||
toEnum 25 = IBTickType_Option_Bid_Exchange
|
||||
toEnum 26 = IBTickType_Option_Ask_Exchange
|
||||
toEnum 27 = IBTickType_Option_Call_Open_Interest
|
||||
toEnum 28 = IBTickType_Option_Put_Open_Interest
|
||||
toEnum 29 = IBTickType_Option_Call_Volume
|
||||
toEnum 30 = IBTickType_Option_Put_Volume
|
||||
toEnum 31 = IBTickType_Index_Future_Premium
|
||||
toEnum 32 = IBTickType_Bid_Exchange
|
||||
toEnum 33 = IBTickType_Ask_Exchange
|
||||
toEnum 34 = IBTickType_Auction_Volume
|
||||
toEnum 35 = IBTickType_Auction_Price
|
||||
toEnum 36 = IBTickType_Auction_Imbalance
|
||||
toEnum 37 = IBTickType_Mark_Price
|
||||
toEnum 38 = IBTickType_Bid_EFP_Computation
|
||||
toEnum 39 = IBTickType_Ask_EFP_Computation
|
||||
toEnum 40 = IBTickType_Last_EFP_Computation
|
||||
toEnum 41 = IBTickType_Open_EFP_Computation
|
||||
toEnum 42 = IBTickType_High_EFP_Computation
|
||||
toEnum 43 = IBTickType_Low_EFP_Computation
|
||||
toEnum 44 = IBTickType_Close_EFP_Computation
|
||||
toEnum 45 = IBTickType_Last_Timestamp
|
||||
toEnum 46 = IBTickType_Shortable
|
||||
toEnum 48 = IBTickType_RT_Volume
|
||||
toEnum 49 = IBTickType_Halted
|
||||
toEnum 50 = IBTickType_Bid_Yield
|
||||
toEnum 51 = IBTickType_Ask_Yield
|
||||
toEnum 52 = IBTickType_Last_Yield
|
||||
toEnum 53 = IBTickType_Custom_Option_Computation
|
||||
toEnum 54 = IBTickType_Trade_Count
|
||||
toEnum 55 = IBTickType_Trade_Rate
|
||||
toEnum 56 = IBTickType_Volume_Rate
|
||||
toEnum 57 = IBTickType_Last_RTH_Trade
|
||||
toEnum 58 = IBTickType_RT_Historical_Volatility
|
||||
toEnum 59 = IBTickType_IB_Dividends
|
||||
toEnum 60 = IBTickType_Bond_Factor_Multiplier
|
||||
toEnum 61 = IBTickType_Regulatory_Imbalance
|
||||
toEnum 62 = IBTickType_News
|
||||
toEnum 63 = IBTickType_ShortTerm_Volume_3_Minutes
|
||||
toEnum 64 = IBTickType_ShortTerm_Volume_5_Minutes
|
||||
toEnum 65 = IBTickType_ShortTerm_Volume_10_Minutes
|
||||
toEnum 66 = IBTickType_Delayed_Bid
|
||||
toEnum 67 = IBTickType_Delayed_Ask
|
||||
toEnum 68 = IBTickType_Delayed_Last
|
||||
toEnum 69 = IBTickType_Delayed_Bid_Size
|
||||
toEnum 70 = IBTickType_Delayed_Ask_Size
|
||||
toEnum 71 = IBTickType_Delayed_Last_Size
|
||||
toEnum 72 = IBTickType_Delayed_High_Price
|
||||
toEnum 73 = IBTickType_Delayed_Low_Price
|
||||
toEnum 74 = IBTickType_Delayed_Volume
|
||||
toEnum 75 = IBTickType_Delayed_Close
|
||||
toEnum 76 = IBTickType_Delayed_Open
|
||||
toEnum 77 = IBTickType_RT_Trade_Volume
|
||||
toEnum 78 = IBTickType_Creditman_mark_price
|
||||
toEnum 79 = IBTickType_Creditman_slow_mark_price
|
||||
toEnum 80 = IBTickType_Delayed_Bid_Option
|
||||
toEnum 81 = IBTickType_Delayed_Ask_Option
|
||||
toEnum 82 = IBTickType_Delayed_Last_Option
|
||||
toEnum 83 = IBTickType_Delayed_Model_Option
|
||||
toEnum 84 = IBTickType_Last_Exchange
|
||||
toEnum 85 = IBTickType_Last_Regulatory_Time
|
||||
toEnum 86 = IBTickType_Futures_Open_Interest
|
||||
toEnum 87 = IBTickType_Average_Option_Volume
|
||||
toEnum 88 = IBTickType_Delayed_Last_Timestamp
|
||||
toEnum 89 = IBTickType_Shortable_Shares
|
||||
toEnum 92 = IBTickType_ETF_Nav_Close
|
||||
toEnum 93 = IBTickType_ETF_Nav_Prior_Close
|
||||
toEnum 94 = IBTickType_ETF_Nav_Bid
|
||||
toEnum 95 = IBTickType_ETF_Nav_Ask
|
||||
toEnum 96 = IBTickType_ETF_Nav_Last
|
||||
toEnum 97 = IBTickType_ETF_Nav_Frozen_Last
|
||||
toEnum 98 = IBTickType_ETF_Nav_High
|
||||
toEnum 99 = IBTickType_ETF_Nav_Low
|
||||
toEnum x = D.trace ("Unknown tick-type-id: " <> show x) $ Unknown x
|
||||
fromEnum (Unknown x) = x
|
||||
fromEnum IBTickType_Bid_Size = 0
|
||||
fromEnum IBTickType_Bid_Price = 1
|
||||
fromEnum IBTickType_Ask_Price = 2
|
||||
fromEnum IBTickType_Ask_Size = 3
|
||||
fromEnum IBTickType_Last_Price = 4
|
||||
fromEnum IBTickType_Last_Size = 5
|
||||
fromEnum IBTickType_High = 6
|
||||
fromEnum IBTickType_Low = 7
|
||||
fromEnum IBTickType_Volume = 8
|
||||
fromEnum IBTickType_Close_Price = 9
|
||||
fromEnum IBTickType_Bid_Option_Computation = 10
|
||||
fromEnum IBTickType_Ask_Option_Computation = 11
|
||||
fromEnum IBTickType_Last_Option_Computation = 12
|
||||
fromEnum IBTickType_Model_Option_Computation = 13
|
||||
fromEnum IBTickType_Open_Tick = 14
|
||||
fromEnum IBTickType_Low_13_Weeks = 15
|
||||
fromEnum IBTickType_High_13_Weeks = 16
|
||||
fromEnum IBTickType_Low_26_Weeks = 17
|
||||
fromEnum IBTickType_High_26_Weeks = 18
|
||||
fromEnum IBTickType_Low_52_Weeks = 19
|
||||
fromEnum IBTickType_High_52_Weeks = 20
|
||||
fromEnum IBTickType_Average_Volume = 21
|
||||
fromEnum IBTickType_Open_Interest = 22
|
||||
fromEnum IBTickType_Option_Historical_Volatility = 23
|
||||
fromEnum IBTickType_Option_Implied_Volatility = 24
|
||||
fromEnum IBTickType_Option_Bid_Exchange = 25
|
||||
fromEnum IBTickType_Option_Ask_Exchange = 26
|
||||
fromEnum IBTickType_Option_Call_Open_Interest = 27
|
||||
fromEnum IBTickType_Option_Put_Open_Interest = 28
|
||||
fromEnum IBTickType_Option_Call_Volume = 29
|
||||
fromEnum IBTickType_Option_Put_Volume = 30
|
||||
fromEnum IBTickType_Index_Future_Premium = 31
|
||||
fromEnum IBTickType_Bid_Exchange = 32
|
||||
fromEnum IBTickType_Ask_Exchange = 33
|
||||
fromEnum IBTickType_Auction_Volume = 34
|
||||
fromEnum IBTickType_Auction_Price = 35
|
||||
fromEnum IBTickType_Auction_Imbalance = 36
|
||||
fromEnum IBTickType_Mark_Price = 37
|
||||
fromEnum IBTickType_Bid_EFP_Computation = 38
|
||||
fromEnum IBTickType_Ask_EFP_Computation = 39
|
||||
fromEnum IBTickType_Last_EFP_Computation = 40
|
||||
fromEnum IBTickType_Open_EFP_Computation = 41
|
||||
fromEnum IBTickType_High_EFP_Computation = 42
|
||||
fromEnum IBTickType_Low_EFP_Computation = 43
|
||||
fromEnum IBTickType_Close_EFP_Computation = 44
|
||||
fromEnum IBTickType_Last_Timestamp = 45
|
||||
fromEnum IBTickType_Shortable = 46
|
||||
fromEnum IBTickType_RT_Volume = 48
|
||||
fromEnum IBTickType_Halted = 49
|
||||
fromEnum IBTickType_Bid_Yield = 50
|
||||
fromEnum IBTickType_Ask_Yield = 51
|
||||
fromEnum IBTickType_Last_Yield = 52
|
||||
fromEnum IBTickType_Custom_Option_Computation = 53
|
||||
fromEnum IBTickType_Trade_Count = 54
|
||||
fromEnum IBTickType_Trade_Rate = 55
|
||||
fromEnum IBTickType_Volume_Rate = 56
|
||||
fromEnum IBTickType_Last_RTH_Trade = 57
|
||||
fromEnum IBTickType_RT_Historical_Volatility = 58
|
||||
fromEnum IBTickType_IB_Dividends = 59
|
||||
fromEnum IBTickType_Bond_Factor_Multiplier = 60
|
||||
fromEnum IBTickType_Regulatory_Imbalance = 61
|
||||
fromEnum IBTickType_News = 62
|
||||
fromEnum IBTickType_ShortTerm_Volume_3_Minutes = 63
|
||||
fromEnum IBTickType_ShortTerm_Volume_5_Minutes = 64
|
||||
fromEnum IBTickType_ShortTerm_Volume_10_Minutes = 65
|
||||
fromEnum IBTickType_Delayed_Bid = 66
|
||||
fromEnum IBTickType_Delayed_Ask = 67
|
||||
fromEnum IBTickType_Delayed_Last = 68
|
||||
fromEnum IBTickType_Delayed_Bid_Size = 69
|
||||
fromEnum IBTickType_Delayed_Ask_Size = 70
|
||||
fromEnum IBTickType_Delayed_Last_Size = 71
|
||||
fromEnum IBTickType_Delayed_High_Price = 72
|
||||
fromEnum IBTickType_Delayed_Low_Price = 73
|
||||
fromEnum IBTickType_Delayed_Volume = 74
|
||||
fromEnum IBTickType_Delayed_Close = 75
|
||||
fromEnum IBTickType_Delayed_Open = 76
|
||||
fromEnum IBTickType_RT_Trade_Volume = 77
|
||||
fromEnum IBTickType_Creditman_mark_price = 78
|
||||
fromEnum IBTickType_Creditman_slow_mark_price = 79
|
||||
fromEnum IBTickType_Delayed_Bid_Option = 80
|
||||
fromEnum IBTickType_Delayed_Ask_Option = 81
|
||||
fromEnum IBTickType_Delayed_Last_Option = 82
|
||||
fromEnum IBTickType_Delayed_Model_Option = 83
|
||||
fromEnum IBTickType_Last_Exchange = 84
|
||||
fromEnum IBTickType_Last_Regulatory_Time = 85
|
||||
fromEnum IBTickType_Futures_Open_Interest = 86
|
||||
fromEnum IBTickType_Average_Option_Volume = 87
|
||||
fromEnum IBTickType_Delayed_Last_Timestamp = 88
|
||||
fromEnum IBTickType_Shortable_Shares = 89
|
||||
fromEnum IBTickType_ETF_Nav_Close = 92
|
||||
fromEnum IBTickType_ETF_Nav_Prior_Close = 93
|
||||
fromEnum IBTickType_ETF_Nav_Bid = 94
|
||||
fromEnum IBTickType_ETF_Nav_Ask = 95
|
||||
fromEnum IBTickType_ETF_Nav_Last = 96
|
||||
fromEnum IBTickType_ETF_Nav_Frozen_Last = 97
|
||||
fromEnum IBTickType_ETF_Nav_High = 98
|
||||
fromEnum IBTickType_ETF_Nav_Low = 99
|
||||
|
||||
type IB_DerivativeSecType = Text
|
||||
|
||||
data IB_SymbolSample = IB_SymbolSample
|
||||
{ symId :: Int
|
||||
, symbol :: Text
|
||||
, secType :: Text
|
||||
, primaryExchange :: Text
|
||||
, currency :: Text
|
||||
, derivatives :: [IB_DerivativeSecType]
|
||||
} deriving (Show, Eq)
|
||||
|
||||
data IB_IN = IB_PositionData
|
||||
| IB_ManagedAccts { accounts :: [Text] }
|
||||
| IB_NextValidID { orderID :: Int }
|
||||
| IB_ErrorMsg { errorID :: Int, errorCode :: Int, errorMsg :: Text }
|
||||
| IB_AccountValue { key :: Text, value :: Text, currency :: Text, accountName :: Text }
|
||||
| IB_AccountUpdateTime { time :: Text }
|
||||
| IB_PortfolioValue { contract :: IBContract, position :: Float, marketPrice :: Float, marketValue :: Float, averageCost :: Float, unrealizedPNL :: Float, realizedPNL :: Float, accountName :: Text }
|
||||
| IB_SymbolSamples { nextId :: Int, samples :: [IB_SymbolSample] }
|
||||
| IB_MarketDataType { tickerId :: Int, dataType :: IBMarketDataType }
|
||||
| IB_TickReqParams { tickerId :: Int, minTick :: Float, bboExchange :: Text, snapshotPermissions :: Int }
|
||||
| IB_TickPrice { tickerId :: Int, tickType :: IBTickType, price :: Float, size :: Int, attrMask :: Int }
|
||||
| IB_TickSize { tickerId :: Int, fieldId :: Int, size :: Int } -- TODO: field is an enum
|
||||
| IB_TickString { tickerId :: Int, tickType :: IBTickType, content :: Text }
|
||||
deriving (Show, Eq)
|
||||
|
||||
voidVersion :: LBS.ByteString -> LBS.ByteString -> Get ()
|
||||
voidVersion t v = do
|
||||
version <- getLazyByteStringNul
|
||||
when (version /= v) $ D.trace ("Unexpected Version '" <> LBS8.unpack version <> "' for Message-Type " <> LBS8.unpack t <> ". Expected: '" <> LBS8.unpack v <> "'.") (return ())
|
||||
|
||||
instance Binary IB_IN where
|
||||
put (IB_ErrorMsg i c m) = put (IBGenericMessage [IBString "4", IBString "2", IBString $ BS8.pack $ show i, IBString $ BS8.pack $ show c, tToIB m])
|
||||
put (IB_AccountValue k v c n) = put (IBGenericMessage [IBString "6", IBString "2", tToIB k, tToIB v, tToIB c, tToIB n])
|
||||
put (IB_PortfolioValue IBContract{..} p pp v c u r n) = put $ IBGenericMessage [ IBString "7", IBString "8" -- id/version
|
||||
, iToIB conId, tToIB symbol, tToIB secType, tToIB lastTradeDate, fToIB strike, tToIB right, tToIB multiplier, tToIB primaryExchange, tToIB currency, tToIB localSymbol, tToIB tradingClass -- contract
|
||||
, fToIB p, fToIB pp, fToIB v, fToIB c, fToIB u, fToIB r, tToIB n
|
||||
]
|
||||
put (IB_AccountUpdateTime t) = put (IBGenericMessage [IBString "8", IBString "1", tToIB t])
|
||||
put (IB_NextValidID v) = put (IBGenericMessage [IBString "9", IBString "1", IBString $ BS8.pack $ show v])
|
||||
put (IB_ManagedAccts a) = put (IBGenericMessage [IBString "15", IBArray $ encodeUtf8 <$> a])
|
||||
put IB_PositionData = put (IBGenericMessage [IBString "61"])
|
||||
put IB_SymbolSamples{} = error "not implemented"
|
||||
put IB_MarketDataType{} = error "not implemented"
|
||||
put IB_TickReqParams{} = error "not implemented"
|
||||
put IB_TickPrice{} = error "not implemented"
|
||||
put IB_TickSize{} = error "not implemented"
|
||||
put IB_TickString{} = error "not implemented"
|
||||
--put (IB_SymbolSamples r s) = put (IBGenericMessage [IBString "79", IBString "1", iToIB r, IBArray $ s]) TODO: FIXME
|
||||
|
||||
get = do
|
||||
msglen <- getWord32be
|
||||
when (msglen == 0) $ fail "empty message"
|
||||
ident <- return <$> getLazyByteStringNul
|
||||
case ident of
|
||||
Just "1" -> do
|
||||
voidVersion "1" "6"
|
||||
IB_TickPrice <$> ib2int <*> (toEnum <$> ib2int) <*> ib2f <*> ib2int <*> ib2int
|
||||
Just "2" -> do
|
||||
voidVersion "2" "6"
|
||||
IB_TickSize <$> ib2int <*> ib2int <*> ib2int
|
||||
Just "4" -> do
|
||||
voidVersion "4" "2"
|
||||
IB_ErrorMsg <$> ib2int <*> ib2int <*> ib2txt
|
||||
Just "6" -> do
|
||||
voidVersion "6" "2"
|
||||
IB_AccountValue <$> ib2txt <*> ib2txt <*> ib2txt <*> ib2txt
|
||||
Just "7" -> do
|
||||
voidVersion "7" "8"
|
||||
c <- IBContract <$> ib2int <*> ib2txt <*> ib2txt <*> ib2txt <*> ib2f <*> ib2txt <*> ib2txt <*> pure "" <*> ib2txt <*> ib2txt <*> ib2txt <*> ib2txt
|
||||
IB_PortfolioValue (c False "" "" "" [] Nothing) <$> ib2f <*> ib2f <*> ib2f <*> ib2f <*> ib2f <*> ib2f <*> ib2txt
|
||||
Just "8" -> do
|
||||
voidVersion "8" "1"
|
||||
IB_AccountUpdateTime <$> ib2txt
|
||||
Just "9" -> do
|
||||
voidVersion "9" "1"
|
||||
IB_NextValidID <$> ib2int
|
||||
Just "15" -> do
|
||||
len <- ib2int
|
||||
IB_ManagedAccts <$> forM [1..len] (const ib2txt)
|
||||
Just "46" -> do
|
||||
voidVersion "46" "6"
|
||||
IB_TickString <$> ib2int <*> (toEnum <$> ib2int) <*> ib2txt
|
||||
Just "58" -> do
|
||||
voidVersion "58" "1"
|
||||
IB_MarketDataType <$> ib2int <*> (toEnum <$> ib2int)
|
||||
Just "61" -> return IB_PositionData
|
||||
Just "79" -> do
|
||||
reqId <- ib2int
|
||||
len <- ib2int
|
||||
symsamples <- forM [1..len] $ const $ do
|
||||
f <- IB_SymbolSample <$> ib2int <*> ib2txt <*> ib2txt <*> ib2txt <*> ib2txt
|
||||
n <- ib2int
|
||||
derivatives <- forM [1..n] $ const ib2txt
|
||||
return $ f derivatives
|
||||
return $ IB_SymbolSamples reqId symsamples
|
||||
Just "81" -> do
|
||||
IB_TickReqParams <$> ib2int <*> ib2f <*> ib2txt <*> ib2int
|
||||
Just x -> do
|
||||
payload <- getByteString (fromIntegral msglen - (if null ident then 0 else length ident + 1) - 1) -- drop rest of message
|
||||
D.trace ("Payload for "<> LBS8.unpack x <> " not understood: " <> show (IBGenericMessage $ fmap IBString . BS.split 0 . BS.init $ payload)) $ return ()
|
||||
fail $ "unkonwn IB_IN type " <> LBS8.unpack x
|
||||
Nothing -> fail "Cannot decode Message: no identifier"
|
||||
|
||||
ib2int :: Get Int
|
||||
ib2int = fromMaybe (-1) . readMaybe . LBS8.unpack <$> getLazyByteStringNul
|
||||
|
||||
ib2f :: Get Float
|
||||
ib2f = fromMaybe (-1) . readMaybe . LBS8.unpack <$> getLazyByteStringNul
|
||||
|
||||
ib2txt :: Get Text
|
||||
ib2txt = decodeUtf8 . LBS.toStrict <$> getLazyByteStringNul
|
||||
Reference in New Issue
Block a user