You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
460 lines
14 KiB
460 lines
14 KiB
{-# LANGUAGE DeriveGeneric #-} |
|
{-# LANGUAGE FlexibleInstances #-} |
|
{-# LANGUAGE OverloadedStrings #-} |
|
{-# LANGUAGE TypeSynonymInstances #-} |
|
|
|
module ATrade.Types ( |
|
TickerId, |
|
Tick(..), |
|
Bar(..), |
|
serializeBar, |
|
serializeBarBody, |
|
deserializeBar, |
|
BarTimeframe(..), |
|
DataType(..), |
|
serializeTick, |
|
serializeTickBody, |
|
deserializeTick, |
|
deserializeTickBody, |
|
SignalId(..), |
|
OrderPrice(..), |
|
Operation(..), |
|
OrderState(..), |
|
Order(..), |
|
mkOrder, |
|
Trade(..), |
|
OrderId(..), |
|
ServerSecurityParams(..), |
|
defaultServerSecurityParams, |
|
ClientSecurityParams(..), |
|
defaultClientSecurityParams, |
|
module ATrade.Price |
|
) where |
|
|
|
import GHC.Generics |
|
|
|
import ATrade.Price |
|
|
|
import Control.Monad |
|
import Data.Aeson |
|
import Data.Aeson.Types |
|
import Data.Binary.Get |
|
import Data.Binary.Put |
|
import Data.ByteString.Lazy as B |
|
import Data.DateTime |
|
import Data.Int |
|
import Data.List as L |
|
import Data.Maybe |
|
import Data.Ratio |
|
import Data.Text as T |
|
import Data.Text.Encoding as E |
|
import Data.Time.Clock |
|
import Data.Time.Clock.POSIX |
|
import Data.Word |
|
|
|
import System.ZMQ4.ZAP |
|
|
|
type TickerId = T.Text |
|
|
|
data DataType = Unknown |
|
| LastTradePrice |
|
| OpenInterest |
|
| BestBid |
|
| BestOffer |
|
| Depth |
|
| TheoryPrice |
|
| Volatility |
|
| TotalSupply |
|
| TotalDemand |
|
deriving (Show, Eq, Ord, Generic) |
|
|
|
instance Enum DataType where |
|
fromEnum x |
|
| x == LastTradePrice = 1 |
|
| x == OpenInterest = 3 |
|
| x == BestBid = 4 |
|
| x == BestOffer = 5 |
|
| x == Depth = 6 |
|
| x == TheoryPrice = 7 |
|
| x == Volatility = 8 |
|
| x == TotalSupply = 9 |
|
| x == TotalDemand = 10 |
|
| x == Unknown = -1 |
|
| otherwise = -1 |
|
|
|
toEnum x |
|
| x == 1 = LastTradePrice |
|
| x == 3 = OpenInterest |
|
| x == 4 = BestBid |
|
| x == 5 = BestOffer |
|
| x == 6 = Depth |
|
| x == 7 = TheoryPrice |
|
| x == 8 = Volatility |
|
| x == 9 = TotalSupply |
|
| x == 10 = TotalDemand |
|
| otherwise = Unknown |
|
|
|
data Tick = Tick { |
|
security :: !T.Text, |
|
datatype :: !DataType, |
|
timestamp :: !UTCTime, |
|
value :: !Price, |
|
volume :: !Integer |
|
} deriving (Show, Eq, Generic) |
|
|
|
putPrice :: Price -> Put |
|
putPrice price = do |
|
let (i, f) = decompose price |
|
putWord64le $ fromInteger . toInteger $ i |
|
putWord32le $ (* 1000) . fromInteger . toInteger $ f |
|
|
|
parsePrice :: Get Price |
|
parsePrice = do |
|
intpart <- (fromIntegral <$> getWord64le) :: Get Int64 |
|
nanopart <- (fromIntegral <$> getWord32le) :: Get Int32 |
|
return $ compose (intpart, nanopart `div` 1000) |
|
|
|
serializeTickHeader :: Tick -> ByteString |
|
serializeTickHeader tick = B.fromStrict . E.encodeUtf8 $ security tick |
|
|
|
serializeTickBody :: Tick -> ByteString |
|
serializeTickBody tick = runPut $ do |
|
putWord32le 1 |
|
putWord64le $ fromIntegral . toSeconds' . timestamp $ tick |
|
putWord32le $ fromIntegral . fracSeconds . timestamp $ tick |
|
putWord32le $ fromIntegral . fromEnum . datatype $ tick |
|
putPrice $ value tick |
|
putWord32le $ fromIntegral $ volume tick |
|
where |
|
fractionalPart :: (RealFrac a) => a -> a |
|
fractionalPart x = x - fromIntegral (truncate x) |
|
toSeconds' = floor . utcTimeToPOSIXSeconds |
|
fracSeconds t = (truncate $ (* 1000000000000) $ utcTimeToPOSIXSeconds t) `mod` 1000000000000 `div` 1000000 |
|
|
|
|
|
serializeTick :: Tick -> [ByteString] |
|
serializeTick tick = serializeTickHeader tick : [serializeTickBody tick] |
|
|
|
parseTick :: Get Tick |
|
parseTick = do |
|
packetType <- fromEnum <$> getWord32le |
|
when (packetType /= 1) $ fail "Expected packettype == 1" |
|
tsec <- getWord64le |
|
tusec <- getWord32le |
|
dt <- toEnum . fromEnum <$> getWord32le |
|
price <- parsePrice |
|
volume <- fromIntegral <$> (fromIntegral <$> getWord32le :: Get Int32) |
|
return Tick { security = "", |
|
datatype = dt, |
|
timestamp = makeTimestamp tsec tusec, |
|
value = price, |
|
volume = volume } |
|
|
|
makeTimestamp :: Word64 -> Word32 -> UTCTime |
|
makeTimestamp sec usec = addUTCTime (fromRational $ toInteger usec % 1000000) (fromSeconds . toInteger $ sec) |
|
|
|
deserializeTick :: [ByteString] -> Maybe Tick |
|
deserializeTick (header:rawData:_) = case runGetOrFail parseTick rawData of |
|
Left (_, _, _) -> Nothing |
|
Right (_, _, tick) -> Just $ tick { security = E.decodeUtf8 . B.toStrict $ header } |
|
|
|
deserializeTick _ = Nothing |
|
|
|
deserializeTickBody :: ByteString -> (ByteString, Maybe Tick) |
|
deserializeTickBody bs = case runGetOrFail parseTick bs of |
|
Left (rest, _, _) -> (rest, Nothing) |
|
Right (rest, _, tick) -> (rest, Just tick) |
|
|
|
data Bar = Bar { |
|
barSecurity :: !TickerId, |
|
barTimestamp :: !UTCTime, |
|
barOpen :: !Price, |
|
barHigh :: !Price, |
|
barLow :: !Price, |
|
barClose :: !Price, |
|
barVolume :: !Integer |
|
} deriving (Show, Eq, Generic) |
|
|
|
-- | Stores timeframe in seconds |
|
newtype BarTimeframe = BarTimeframe { unBarTimeframe :: Int } |
|
deriving (Show, Eq, Ord) |
|
|
|
serializeBar :: BarTimeframe -> Bar -> [ByteString] |
|
serializeBar tf bar = serializeBarHeader tf bar : [serializeBarBody tf bar] |
|
|
|
-- | Encodes bar header as tickerid:timeframe_seconds; |
|
-- Why ';' at the end? To support correct 0mq subscriptions. When we subscribe to topic, |
|
-- we actually subscribe by all topics which has requested subscription as a prefix. |
|
serializeBarHeader :: BarTimeframe -> Bar -> ByteString |
|
serializeBarHeader tf bar = |
|
B.fromStrict . E.encodeUtf8 $ (barSecurity bar) `T.append` encodeTimeframe tf |
|
where |
|
encodeTimeframe tf = mconcat [ ":", (T.pack . show $ unBarTimeframe tf), ";" ] |
|
|
|
serializeBarBody :: BarTimeframe -> Bar -> ByteString |
|
serializeBarBody tf bar = runPut $ do |
|
putWord32le 2 |
|
putWord32le $ fromIntegral $ unBarTimeframe tf |
|
putWord64le $ fromIntegral . toSeconds' . barTimestamp $ bar |
|
putWord32le $ fromIntegral . fracSeconds . barTimestamp $ bar |
|
putPrice $ barOpen bar |
|
putPrice $ barHigh bar |
|
putPrice $ barLow bar |
|
putPrice $ barClose bar |
|
putWord32le $ fromIntegral $ barVolume bar |
|
where |
|
fractionalPart :: (RealFrac a) => a -> a |
|
fractionalPart x = x - fromIntegral (truncate x) |
|
toSeconds' = floor . utcTimeToPOSIXSeconds |
|
fracSeconds t = (truncate $ (* 1000000000000) $ utcTimeToPOSIXSeconds t) `mod` 1000000000000 `div` 1000000 |
|
|
|
parseBar :: Get (BarTimeframe, Bar) |
|
parseBar = do |
|
packetType <- fromEnum <$> getWord32le |
|
when (packetType /= 2) $ fail "Expected packettype == 2" |
|
tf <- fromIntegral <$> getWord32le |
|
tsec <- getWord64le |
|
tusec <- getWord32le |
|
open_ <- parsePrice |
|
high_ <- parsePrice |
|
low_ <- parsePrice |
|
close_ <- parsePrice |
|
volume_ <- fromIntegral <$> getWord32le |
|
return (BarTimeframe tf, Bar { barSecurity = "", |
|
barTimestamp = makeTimestamp tsec tusec, |
|
barOpen = open_, |
|
barHigh = high_, |
|
barLow = low_, |
|
barClose = close_, |
|
barVolume = volume_ }) |
|
|
|
deserializeBar :: [ByteString] -> Maybe (BarTimeframe, Bar) |
|
deserializeBar (header:rawData:_) = case runGetOrFail parseBar rawData of |
|
Left (_, _, _) -> Nothing |
|
Right (_, _, (tf, bar)) -> |
|
case E.decodeUtf8' . B.toStrict $ header of |
|
Right fullHeader -> Just $ (tf, bar { barSecurity = T.takeWhile (/= ':') fullHeader }) |
|
Left err -> Nothing |
|
|
|
deserializeBar _ = Nothing |
|
|
|
data SignalId = SignalId { |
|
strategyId :: T.Text, |
|
signalName :: T.Text, |
|
comment :: T.Text } |
|
deriving (Show, Eq) |
|
|
|
instance FromJSON SignalId where |
|
parseJSON (Object o) = SignalId <$> |
|
o .: "strategy-id" .!= "" <*> |
|
o .: "signal-name" .!= "" <*> |
|
o .: "comment" .!= "" |
|
parseJSON _ = fail "Should be object" |
|
|
|
instance ToJSON SignalId where |
|
toJSON sid = object [ "strategy-id" .= strategyId sid, |
|
"signal-name" .= signalName sid, |
|
"comment" .= comment sid ] |
|
|
|
data OrderPrice = Market | Limit Price | Stop Price Price | StopMarket Price |
|
deriving (Show, Eq) |
|
|
|
instance FromJSON OrderPrice where |
|
parseJSON (String s) = when (s /= "market") (fail "If string, then should be 'market'") >> |
|
return Market |
|
|
|
parseJSON a@(Number n) = do |
|
price <- parseJSON a |
|
return $ Limit price |
|
parseJSON (Object v) = do |
|
triggerPrice <- v .: "trigger" |
|
case triggerPrice of |
|
a@(Number trpr) -> do |
|
trprice <- parseJSON a |
|
execPrice <- v .: "execution" |
|
case execPrice of |
|
(String s) -> if s /= "market" |
|
then (fail "If string, then should be 'market'") |
|
else return $ StopMarket trprice |
|
(Number n) -> return $ Stop trprice (fromScientific n) |
|
_ -> fail "Should be either number or 'market'" |
|
_ -> fail "Should be a number" |
|
|
|
parseJSON _ = fail "OrderPrice" |
|
|
|
instance ToJSON OrderPrice where |
|
toJSON op = case op of |
|
Market -> String "market" |
|
(Limit d) -> Number $ convert d |
|
(Stop t e) -> object [ "trigger" .= convert t, "execution" .= convert e ] |
|
(StopMarket t) -> object [ "trigger" .= convert t, "execution" .= ("market" :: Text) ] |
|
where |
|
convert = fromRational . toRational |
|
|
|
data Operation = Buy | Sell |
|
deriving (Show, Eq) |
|
|
|
instance FromJSON Operation where |
|
parseJSON (String s) |
|
| s == "buy" = return Buy |
|
| s == "sell" = return Sell |
|
| otherwise = fail "Should be either 'buy' or 'sell'" |
|
parseJSON _ = fail "Should be string" |
|
|
|
instance ToJSON Operation where |
|
toJSON Buy = String "buy" |
|
toJSON Sell = String "sell" |
|
|
|
data OrderState = Unsubmitted |
|
| Submitted |
|
| PartiallyExecuted |
|
| Executed |
|
| Cancelled |
|
| Rejected |
|
| OrderError |
|
deriving (Show, Eq) |
|
|
|
instance FromJSON OrderState where |
|
parseJSON (String s) |
|
| s == "unsubmitted" = return Unsubmitted |
|
| s == "submitted" = return Submitted |
|
| s == "partially-executed" = return PartiallyExecuted |
|
| s == "executed" = return Executed |
|
| s == "cancelled" = return Cancelled |
|
| s == "rejected" = return Rejected |
|
| s == "error" = return OrderError |
|
| otherwise = fail "Invlaid state" |
|
|
|
parseJSON _ = fail "Should be string" |
|
|
|
instance ToJSON OrderState where |
|
toJSON os = case os of |
|
Unsubmitted -> String "unsubmitted" |
|
Submitted -> String "submitted" |
|
PartiallyExecuted -> String "partially-executed" |
|
Executed -> String "executed" |
|
Cancelled -> String "cancelled" |
|
Rejected -> String "rejected" |
|
OrderError -> String "error" |
|
|
|
type OrderId = Integer |
|
|
|
data Order = Order { |
|
orderId :: OrderId, |
|
orderAccountId :: T.Text, |
|
orderSecurity :: T.Text, |
|
orderPrice :: OrderPrice, |
|
orderQuantity :: Integer, |
|
orderExecutedQuantity :: Integer, |
|
orderOperation :: Operation, |
|
orderState :: OrderState, |
|
orderSignalId :: SignalId } |
|
deriving (Show, Eq) |
|
|
|
mkOrder = Order { orderId = 0, |
|
orderAccountId = "", |
|
orderSecurity = "", |
|
orderPrice = Market, |
|
orderQuantity = 0, |
|
orderExecutedQuantity = 0, |
|
orderOperation = Buy, |
|
orderState = Unsubmitted, |
|
orderSignalId = SignalId "" "" "" } |
|
|
|
instance FromJSON Order where |
|
parseJSON (Object v) = Order <$> |
|
v .:? "order-id" .!= 0 <*> |
|
v .: "account" <*> |
|
v .: "security" <*> |
|
v .: "price" <*> |
|
v .: "quantity" <*> |
|
v .:? "executed-quantity" .!= 0 <*> |
|
v .: "operation" <*> |
|
v .: "state" .!= Unsubmitted <*> |
|
v .: "signal-id" |
|
|
|
parseJSON _ = fail "Should be string" |
|
|
|
instance ToJSON Order where |
|
toJSON order = object $ base ++ catMaybes [ifMaybe "order-id" (/= 0) (orderId order), ifMaybe "executed-quantity" (/= 0) (orderExecutedQuantity order)] |
|
where |
|
base = [ "account" .= orderAccountId order, |
|
"security" .= orderSecurity order, |
|
"price" .= orderPrice order, |
|
"quantity" .= orderQuantity order, |
|
"operation" .= orderOperation order, |
|
"state" .= orderState order, |
|
"signal-id" .= orderSignalId order ] |
|
ifMaybe :: (ToJSON a, KeyValue b) => Text -> (a -> Bool) -> a -> Maybe b |
|
ifMaybe name pred val = if pred val then Just (name .= val) else Nothing |
|
|
|
data Trade = Trade { |
|
tradeOrderId :: OrderId, |
|
tradePrice :: Price, |
|
tradeQuantity :: Integer, |
|
tradeVolume :: Price, |
|
tradeVolumeCurrency :: T.Text, |
|
tradeOperation :: Operation, |
|
tradeAccount :: T.Text, |
|
tradeSecurity :: T.Text, |
|
tradeTimestamp :: UTCTime, |
|
tradeCommission :: Price, |
|
tradeSignalId :: SignalId } |
|
deriving (Show, Eq) |
|
|
|
instance FromJSON Trade where |
|
parseJSON (Object trade) = Trade <$> |
|
trade .: "order-id" <*> |
|
trade .: "price" <*> |
|
trade .: "quantity" <*> |
|
trade .: "volume" <*> |
|
trade .: "volume-currency" <*> |
|
trade .: "operation" <*> |
|
trade .: "account" <*> |
|
trade .: "security" <*> |
|
trade .: "execution-time" <*> |
|
trade .:? "commission" .!= 0 <*> |
|
trade .: "signal-id" |
|
parseJSON _ = fail "Should be object" |
|
|
|
instance ToJSON Trade where |
|
toJSON trade = object [ "order-id" .= tradeOrderId trade, |
|
"price" .= tradePrice trade, |
|
"quantity" .= tradeQuantity trade, |
|
"volume" .= tradeVolume trade, |
|
"volume-currency" .= tradeVolumeCurrency trade, |
|
"operation" .= tradeOperation trade, |
|
"account" .= tradeAccount trade, |
|
"security" .= tradeSecurity trade, |
|
"execution-time" .= tradeTimestamp trade, |
|
"commission" .= tradeCommission trade, |
|
"signal-id" .= tradeSignalId trade] |
|
|
|
data ServerSecurityParams = ServerSecurityParams { |
|
sspDomain :: Maybe T.Text, |
|
sspCertificate :: Maybe CurveCertificate |
|
} deriving (Show, Eq) |
|
|
|
defaultServerSecurityParams = ServerSecurityParams { |
|
sspDomain = Nothing, |
|
sspCertificate = Nothing |
|
} |
|
|
|
data ClientSecurityParams = ClientSecurityParams { |
|
cspCertificate :: Maybe CurveCertificate, |
|
cspServerCertificate :: Maybe CurveCertificate |
|
} deriving (Show, Eq) |
|
|
|
defaultClientSecurityParams = ClientSecurityParams { |
|
cspCertificate = Nothing, |
|
cspServerCertificate = Nothing |
|
} |
|
|
|
data TickerInfo = TickerInfo { |
|
tiTicker :: TickerId, |
|
tiClass :: T.Text, |
|
tiBase :: Maybe TickerId, |
|
tiLotSize :: Integer, |
|
tiTickSize :: Price |
|
} deriving (Show, Eq) |
|
|
|
|