Browse Source

Update resolver to lts-20.18

master
Denis Tereshkin 3 years ago
parent
commit
7ac33e83ef
  1. 1
      libatrade.cabal
  2. 26
      src/ATrade/Broker/Protocol.hs
  3. 6
      src/ATrade/Types.hs
  4. 9
      stack.yaml

1
libatrade.cabal

@ -38,7 +38,6 @@ library
, bytestring , bytestring
, connection , connection
, containers , containers
, datetime
, errors , errors
, extra , extra
, gitrev , gitrev

26
src/ATrade/Broker/Protocol.hs

@ -22,8 +22,8 @@ import ATrade.Types
import Control.Applicative ((<|>)) import Control.Applicative ((<|>))
import Control.Error.Util import Control.Error.Util
import Data.Aeson import Data.Aeson
import Data.Aeson.KeyMap as KM
import Data.Aeson.Types hiding (parse) import Data.Aeson.Types hiding (parse)
import qualified Data.HashMap.Strict as HM
import Data.Int import Data.Int
import qualified Data.Text as T import qualified Data.Text as T
import Data.Text.Encoding import Data.Text.Encoding
@ -56,16 +56,16 @@ instance FromJSON Notification where
parseJSON = withObject "notification" $ \obj -> parseNotification obj parseJSON = withObject "notification" $ \obj -> parseNotification obj
where where
parseNotification obj = parseNotification obj =
case HM.lookup "notification-sqnum" obj of case KM.lookup "notification-sqnum" obj of
Just (Number sqnum) -> parseTrade (NotificationSqnum $ truncate sqnum) obj <|> Just (Number sqnum) -> parseTrade (NotificationSqnum $ truncate sqnum) obj <|>
parseOrder (NotificationSqnum $ truncate sqnum) obj <|> parseOrder (NotificationSqnum $ truncate sqnum) obj <|>
fail "Can't parse notification" fail "Can't parse notification"
Just _ -> fail "Invalid sqnum" Just _ -> fail "Invalid sqnum"
Nothing -> fail "Unable to lookup notification sqnum" Nothing -> fail "Unable to lookup notification sqnum"
parseTrade sqnum obj = case HM.lookup "trade" obj of parseTrade sqnum obj = case KM.lookup "trade" obj of
Just val -> TradeNotification sqnum <$> (parseJSON val) Just val -> TradeNotification sqnum <$> (parseJSON val)
Nothing -> fail "Can't parse trade" Nothing -> fail "Can't parse trade"
parseOrder sqnum obj = case HM.lookup "order-state" obj of parseOrder sqnum obj = case KM.lookup "order-state" obj of
Just v -> withObject "object" (\os -> do Just v -> withObject "object" (\os -> do
oid <- os .: "order-id" oid <- os .: "order-id"
ns <- os .: "new-state" ns <- os .: "new-state"
@ -97,16 +97,16 @@ instance FromJSON BrokerServerRequest where
where where
parseRequest :: RequestSqnum -> ClientIdentity -> Object -> Parser BrokerServerRequest parseRequest :: RequestSqnum -> ClientIdentity -> Object -> Parser BrokerServerRequest
parseRequest sqnum clientIdentity obj parseRequest sqnum clientIdentity obj
| HM.member "order" obj = do | KM.member "order" obj = do
order <- obj .: "order" order <- obj .: "order"
RequestSubmitOrder sqnum clientIdentity <$> parseJSON order RequestSubmitOrder sqnum clientIdentity <$> parseJSON order
| HM.member "cancel-order" obj = do | KM.member "cancel-order" obj = do
orderId <- obj .: "cancel-order" orderId <- obj .: "cancel-order"
RequestCancelOrder sqnum clientIdentity <$> parseJSON orderId RequestCancelOrder sqnum clientIdentity <$> parseJSON orderId
| HM.member "request-notifications" obj = do | KM.member "request-notifications" obj = do
initialSqnum <- obj .: "initial-sqnum" initialSqnum <- obj .: "initial-sqnum"
return (RequestNotifications sqnum clientIdentity (NotificationSqnum initialSqnum)) return (RequestNotifications sqnum clientIdentity (NotificationSqnum initialSqnum))
| HM.member "request-current-sqnum" obj = | KM.member "request-current-sqnum" obj =
return (RequestCurrentSqnum sqnum clientIdentity) return (RequestCurrentSqnum sqnum clientIdentity)
parseRequest _ _ _ = fail "Invalid request object" parseRequest _ _ _ = fail "Invalid request object"
@ -134,17 +134,17 @@ data BrokerServerResponse = ResponseOk
instance FromJSON BrokerServerResponse where instance FromJSON BrokerServerResponse where
parseJSON = withObject "object" (\obj -> parseJSON = withObject "object" (\obj ->
if | HM.member "result" obj -> do if | KM.member "result" obj -> do
result <- obj .: "result" result <- obj .: "result"
if (result :: T.Text) == "success" if (result :: T.Text) == "success"
then return ResponseOk then return ResponseOk
else do else do
msg <- obj .:? "message" .!= "" msg <- obj .:? "message" .!= ""
return (ResponseError msg) return (ResponseError msg)
| HM.member "notifications" obj -> do | KM.member "notifications" obj -> do
notifications <- obj .: "notifications" notifications <- obj .: "notifications"
ResponseNotifications <$> parseJSON notifications ResponseNotifications <$> parseJSON notifications
| HM.member "current-sqnum" obj -> do | KM.member "current-sqnum" obj -> do
rawSqnum <- obj .: "current-sqnum" rawSqnum <- obj .: "current-sqnum"
return $ ResponseCurrentSqnum (NotificationSqnum rawSqnum) return $ ResponseCurrentSqnum (NotificationSqnum rawSqnum)
| otherwise -> fail "Unable to parse BrokerServerResponse") | otherwise -> fail "Unable to parse BrokerServerResponse")
@ -234,11 +234,11 @@ instance ToJSON TradeSinkMessage where
instance FromJSON TradeSinkMessage where instance FromJSON TradeSinkMessage where
parseJSON = withObject "object" (\obj -> parseJSON = withObject "object" (\obj ->
case HM.lookup "command" obj of case KM.lookup "command" obj of
Nothing -> parseTrade obj Nothing -> parseTrade obj
Just cmd -> return TradeSinkHeartBeat) Just cmd -> return TradeSinkHeartBeat)
where where
parseTrade obj = case HM.lookup "trade" obj of parseTrade obj = case KM.lookup "trade" obj of
Just (Object v) -> do Just (Object v) -> do
acc <- v .: "account" acc <- v .: "account"
sec <- v .: "security" sec <- v .: "security"

6
src/ATrade/Types.hs

@ -37,11 +37,11 @@ import ATrade.Price
import Control.Monad import Control.Monad
import Data.Aeson import Data.Aeson
import Data.Aeson.Key
import Data.Aeson.Types import Data.Aeson.Types
import Data.Binary.Get import Data.Binary.Get
import Data.Binary.Put import Data.Binary.Put
import Data.ByteString.Lazy as B import Data.ByteString.Lazy as B
import Data.DateTime
import Data.Int import Data.Int
import Data.List as L import Data.List as L
import Data.Maybe import Data.Maybe
@ -151,7 +151,7 @@ parseTick = do
volume = volume } volume = volume }
makeTimestamp :: Word64 -> Word32 -> UTCTime makeTimestamp :: Word64 -> Word32 -> UTCTime
makeTimestamp sec usec = addUTCTime (fromRational $ toInteger usec % 1000000) (fromSeconds . toInteger $ sec) makeTimestamp sec usec = addUTCTime (fromRational $ toInteger usec % 1000000) (posixSecondsToUTCTime . fromIntegral $ sec)
deserializeTick :: [ByteString] -> Maybe Tick deserializeTick :: [ByteString] -> Maybe Tick
deserializeTick (header:rawData:_) = case runGetOrFail parseTick rawData of deserializeTick (header:rawData:_) = case runGetOrFail parseTick rawData of
@ -386,7 +386,7 @@ instance ToJSON Order where
"state" .= orderState order, "state" .= orderState order,
"signal-id" .= orderSignalId order ] "signal-id" .= orderSignalId order ]
ifMaybe :: (ToJSON a, KeyValue b) => Text -> (a -> Bool) -> a -> Maybe b ifMaybe :: (ToJSON a, KeyValue b) => Text -> (a -> Bool) -> a -> Maybe b
ifMaybe name pred val = if pred val then Just (name .= val) else Nothing ifMaybe name pred val = if pred val then Just (fromText name .= val) else Nothing
data Trade = Trade { data Trade = Trade {
tradeOrderId :: OrderId, tradeOrderId :: OrderId,

9
stack.yaml

@ -15,7 +15,7 @@
# resolver: # resolver:
# name: custom-snapshot # name: custom-snapshot
# location: "./custom-snapshot.yaml" # location: "./custom-snapshot.yaml"
resolver: lts-18.18 resolver: lts-20.18
# User packages to be built. # User packages to be built.
# Various formats can be used as shown in the example below. # Various formats can be used as shown in the example below.
@ -41,10 +41,11 @@ packages:
# Dependency packages to be pulled from upstream that are not in the resolver # Dependency packages to be pulled from upstream that are not in the resolver
# (e.g., acme-missiles-0.3) # (e.g., acme-missiles-0.3)
extra-deps: extra-deps:
- datetime-0.3.1
- hexdump-0.1 - hexdump-0.1
- co-log-0.4.0.1@sha256:3d4c17f37693c80d1aa2c41669bc3438fac3e89dc5f479e57d79bc3ddc4dfcc5,5087 - co-log-0.5.0.0
- ansi-terminal-0.10.3@sha256:e2fbcef5f980dc234c7ad8e2fa433b0e8109132c9e643bc40ea5608cd5697797,3226 - chronos-1.1.5@sha256:ca35be5fdbbb384414226b4467c6d1c8b44defe59a9c8a3af32c1c5fb250c781,3830
- typerep-map-0.5.0.0@sha256:34f1ba9b268a6d52e26ae460011a5571e8099b50a3f4a7c8db25dd8efe3be8ee,4667
# Override default flag values for local packages and extra-deps # Override default flag values for local packages and extra-deps
flags: {} flags: {}

Loading…
Cancel
Save