Skip to content

Commit

Permalink
fixes due to undefined data type
Browse files Browse the repository at this point in the history
  • Loading branch information
Robert Bermani committed Jul 24, 2015
1 parent e2afbcd commit 41f09ea
Show file tree
Hide file tree
Showing 2 changed files with 29 additions and 28 deletions.
2 changes: 1 addition & 1 deletion src/IB/Client.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -67,7 +67,7 @@ greetServer server =
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
sCo = server { s_connected = True
, s_version = serv_ver
, s_twsTime = twsTime
}
Expand Down
55 changes: 28 additions & 27 deletions src/IB/Client/Request.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -21,21 +21,21 @@ import qualified System.IO as S
import qualified Data.ByteString.Char8 as B
import Data.Maybe

import IB.Client.Exception
import IB.Client.Nums
import IB.Client.Types
import IB.Exception
import IB.Nums
import IB.Types

data ReqHeader =
ReqHeader
{ rqh_msgId :: Int
, 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
Expand Down Expand Up @@ -156,10 +156,10 @@ getHeaderCon s rqh con =

case () of
_ | not connected -> throwIO $ IBExc (rqh_errId rqh) NotConnected ""
| rqh_minVer rqh /= undefined ->
when ((serv_ver < rqh_minVer rqh) && not ( null ( ct_tradingClass con)) || ct_conId con > 0)
| (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)

Expand All @@ -172,9 +172,10 @@ getHeader s rqh =

case () of
_ | not connected -> throwIO $ IBExc (rqh_errId rqh) NotConnected ""
| rqh_minVer rqh /= undefined -> when (serv_ver < rqh_minVer rqh) $ throwIO $ IBExc (rqh_errId rqh) UpdateTWS (rqh_errMsg rqh)
| (rqh_minVer rqh) /= Nothing -> when (serv_ver < fromJust (rqh_minVer rqh)) $ throwIO $ IBExc (rqh_errId rqh) UpdateTWS (rqh_errMsg rqh)

| rqh_exAuth rqh /= undefined -> unless mExtraAuth $ throwIO $ IBExc no_valid_id UpdateTWS " Intent to authenticate needs to be expressed during initial connect request."
| (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)

Expand Down Expand Up @@ -295,7 +296,7 @@ request s rq @ (MktDepthReq { rqp_tickerId = tid

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
Expand Down Expand Up @@ -366,7 +367,7 @@ request s rq @ (HistoricalDataReq {rqp_tickerId = tid
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
Expand Down Expand Up @@ -400,7 +401,7 @@ request s rq @ (ExerciseOptionsReq { rqp_tickerId = tid
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
Expand Down Expand Up @@ -474,7 +475,7 @@ request s rq @ (CancelRealTimeBars tid) =
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
Expand All @@ -486,7 +487,7 @@ request s rq @ (CancelFundamentalData tid) =
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
Expand All @@ -495,7 +496,7 @@ request s rq @ (CancelCalcImpliedVolatility tid) =
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
Expand All @@ -504,7 +505,7 @@ request s rq @ (CancelCalcOptionPrice tid) =
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
wFlush s
Expand All @@ -524,7 +525,7 @@ request s rq @ PositionsReq =

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
Expand All @@ -533,40 +534,40 @@ request s rq @ (CancelAccountSummary req_id) =
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
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
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
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
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
Expand All @@ -575,7 +576,7 @@ request s rq @ (SubscribeToGroupEvents reqId gid) =

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
Expand All @@ -584,7 +585,7 @@ request s rq @ (UpdateDisplayGroup reqId contractInfo) =

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
Expand Down

0 comments on commit 41f09ea

Please sign in to comment.