diff --git a/src/ATrade/Broker/Client.hs b/src/ATrade/Broker/Client.hs index 43a6d20..053e93f 100644 --- a/src/ATrade/Broker/Client.hs +++ b/src/ATrade/Broker/Client.hs @@ -35,7 +35,7 @@ data BrokerClientHandle = BrokerClientHandle { tid :: ThreadId, completionMvar :: MVar (), killMvar :: MVar (), - submitOrder :: Order -> IO (Either T.Text OrderId), + submitOrder :: Order -> IO (Either T.Text ()), cancelOrder :: OrderId -> IO (Either T.Text ()), getNotifications :: IO (Either T.Text [Notification]), cmdVar :: MVar (BrokerServerRequest, MVar BrokerServerResponse), @@ -108,16 +108,16 @@ stopBrokerClient handle = putMVar (killMvar handle) () >> yield >> killThread (t nextId cnt = atomicModifyIORef' cnt (\v -> (v + 1, v)) -bcSubmitOrder :: ClientIdentity -> IORef Int64 -> MVar (BrokerServerRequest, MVar BrokerServerResponse) -> Order -> IO (Either T.Text OrderId) +bcSubmitOrder :: ClientIdentity -> IORef Int64 -> MVar (BrokerServerRequest, MVar BrokerServerResponse) -> Order -> IO (Either T.Text ()) bcSubmitOrder clientIdentity idCounter cmdVar order = do respVar <- newEmptyMVar sqnum <- nextId idCounter putMVar cmdVar (RequestSubmitOrder sqnum clientIdentity order, respVar) resp <- takeMVar respVar case resp of - (ResponseOrderSubmitted oid) -> return $ Right oid - (ResponseError msg) -> return $ Left msg - _ -> return $ Left "Unknown error" + ResponseOk -> return $ Right () + (ResponseError msg) -> return $ Left msg + _ -> return $ Left "Unknown error" bcCancelOrder :: ClientIdentity -> IORef RequestSqnum -> MVar (BrokerServerRequest, MVar BrokerServerResponse) -> OrderId -> IO (Either T.Text ()) bcCancelOrder clientIdentity idCounter cmdVar orderId = do @@ -126,9 +126,9 @@ bcCancelOrder clientIdentity idCounter cmdVar orderId = do putMVar cmdVar (RequestCancelOrder sqnum clientIdentity orderId, respVar) resp <- takeMVar respVar case resp of - (ResponseOrderCancelled oid) -> return $ Right () - (ResponseError msg) -> return $ Left msg - _ -> return $ Left "Unknown error" + ResponseOk -> return $ Right () + (ResponseError msg) -> return $ Left msg + _ -> return $ Left "Unknown error" bcGetNotifications :: ClientIdentity -> IORef RequestSqnum -> IORef NotificationSqnum -> MVar (BrokerServerRequest, MVar BrokerServerResponse) -> IO (Either T.Text [Notification]) bcGetNotifications clientIdentity idCounter notifSqnumRef cmdVar = do diff --git a/src/ATrade/Broker/Protocol.hs b/src/ATrade/Broker/Protocol.hs index 423fac7..b07d8c1 100644 --- a/src/ATrade/Broker/Protocol.hs +++ b/src/ATrade/Broker/Protocol.hs @@ -118,33 +118,29 @@ instance ToJSON BrokerServerRequest where "request-notifications" .= ("" :: T.Text), "initial-sqnum" .= unNotificationSqnum initialNotificationSqnum] -data BrokerServerResponse = ResponseOrderSubmitted OrderId - | ResponseOrderCancelled OrderId +data BrokerServerResponse = ResponseOk | ResponseNotifications [Notification] | ResponseError T.Text deriving (Eq, Show) instance FromJSON BrokerServerResponse where parseJSON = withObject "object" (\obj -> - if | HM.member "order-id" obj -> do - oid <- obj .: "order-id" - return $ ResponseOrderSubmitted oid - | HM.member "order-cancelled" obj -> do - oid <- obj .: "order-cancelled" - return $ ResponseOrderCancelled oid + if | HM.member "result" obj -> do + result <- obj .: "result" + if (result :: T.Text) == "success" + then return ResponseOk + else do + msg <- obj .:? "message" .!= "" + return (ResponseError msg) | HM.member "notifications" obj -> do notifications <- obj .: "notifications" ResponseNotifications <$> parseJSON notifications - | HM.member "error" obj -> do - error <- obj .: "error" - ResponseError <$> parseJSON error | otherwise -> fail "Unable to parse BrokerServerResponse") instance ToJSON BrokerServerResponse where - toJSON (ResponseOrderSubmitted oid) = object [ "order-id" .= oid ] - toJSON (ResponseOrderCancelled oid) = object [ "order-cancelled" .= oid ] + toJSON ResponseOk = object [ "result" .= ("success" :: T.Text) ] toJSON (ResponseNotifications notifications) = object [ "notifications" .= notifications ] - toJSON (ResponseError errorMessage) = object [ "error" .= errorMessage ] + toJSON (ResponseError errorMessage) = object [ "result" .= ("error" :: T.Text), "message" .= errorMessage ] data TradeSinkMessage = TradeSinkHeartBeat | TradeSinkTrade { tsAccountId :: T.Text, diff --git a/src/ATrade/Broker/Server.hs b/src/ATrade/Broker/Server.hs index 6ba66b9..6e7096b 100644 --- a/src/ATrade/Broker/Server.hs +++ b/src/ATrade/Broker/Server.hs @@ -196,12 +196,12 @@ brokerServerThread state = finally brokerServerThread' cleanup case findBrokerForAccount (orderAccountId order) bros of Just bro -> do globalOrderId <- nextOrderId - let fullOrderId = (FullOrderId clientIdentity (orderId order)) + let fullOrderId = FullOrderId clientIdentity (orderId order) atomicMapIORef state (\s -> s { orderToBroker = M.insert fullOrderId bro (orderToBroker s), orderMap = BM.insert fullOrderId globalOrderId (orderMap s) }) submitOrder bro order { orderId = globalOrderId } - return $ ResponseOrderSubmitted (orderId order) + return ResponseOk Nothing -> do warningM "Broker.Server" $ "Unknown account: " ++ T.unpack (orderAccountId order) @@ -213,7 +213,7 @@ brokerServerThread state = finally brokerServerThread' cleanup case (M.lookup fullOrderId m, BM.lookup fullOrderId bm) of (Just bro, Just globalOrderId) -> do cancelOrder bro globalOrderId - return $ ResponseOrderCancelled localOrderId + return ResponseOk _ -> return $ ResponseError "Unknown order" RequestNotifications sqnum clientIdentity initialSqnum -> do maybeNs <- M.lookup clientIdentity . pendingNotifications <$> readIORef state diff --git a/test/ArbitraryInstances.hs b/test/ArbitraryInstances.hs index 0f0d58d..0a733ba 100644 --- a/test/ArbitraryInstances.hs +++ b/test/ArbitraryInstances.hs @@ -113,14 +113,15 @@ instance Arbitrary BrokerServerRequest where if | t == 1 -> RequestSubmitOrder <$> arbitrary <*> arbitrary <*> arbitrary | t == 2 -> RequestCancelOrder <$> arbitrary <*> arbitrary <*> arbitrary | t == 3 -> RequestNotifications <$> arbitrary <*> arbitrary <*> arbitrary + | otherwise -> error "Invalid argument" instance Arbitrary BrokerServerResponse where arbitrary = do - t <- choose (1, 4) :: Gen Int - if | t == 1 -> ResponseOrderSubmitted <$> arbitrary - | t == 2 -> ResponseOrderCancelled <$> arbitrary - | t == 3 -> ResponseNotifications <$> arbitrary - | t == 4 -> ResponseError <$> arbitrary + t <- choose (1, 3) :: Gen Int + if | t == 1 -> return ResponseOk + | t == 2 -> ResponseNotifications <$> arbitrary + | t == 3 -> ResponseError <$> arbitrary + | otherwise -> error "Invalid argument" instance Arbitrary P.Price where arbitrary = P.Price <$> (arbitrary `suchThat` (\p -> abs p < 1000000000 * 10000000)) diff --git a/test/TestBrokerClient.hs b/test/TestBrokerClient.hs index cbf682e..52bfc79 100644 --- a/test/TestBrokerClient.hs +++ b/test/TestBrokerClient.hs @@ -73,8 +73,8 @@ testBrokerClientCancelOrder = testCase "Broker client: submit and cancel order" maybeOid <- submitOrder broC defaultOrder case maybeOid of Left err -> assertFailure "Invalid response" - Right oid -> do - rc <- cancelOrder broC oid + Right _ -> do + rc <- cancelOrder broC (orderId defaultOrder) case rc of Left err -> assertFailure "Invalid response" Right _ -> return() diff --git a/test/TestBrokerServer.hs b/test/TestBrokerServer.hs index 4956012..292549c 100644 --- a/test/TestBrokerServer.hs +++ b/test/TestBrokerServer.hs @@ -115,9 +115,9 @@ testBrokerServerSubmitOrder = testCaseSteps "Broker Server submits order" $ \ste step "Reading response" resp <- decode . BL.fromStrict <$> receive sock case resp of - Just (ResponseOrderSubmitted _) -> return () - Just _ -> assertFailure "Invalid response" - Nothing -> assertFailure "Invalid response" + Just ResponseOk -> return () + Just _ -> assertFailure "Invalid response" + Nothing -> assertFailure "Invalid response" testBrokerServerSubmitOrderDifferentIdentities :: TestTree testBrokerServerSubmitOrderDifferentIdentities = testCaseSteps "Broker Server submits order: different identities" $ \step -> withContext $ \ctx -> do @@ -139,16 +139,16 @@ testBrokerServerSubmitOrderDifferentIdentities = testCaseSteps "Broker Server su step "Reading response for identity1" resp <- decode . BL.fromStrict <$> receive sock1 case resp of - Just (ResponseOrderSubmitted localOrderId) -> localOrderId @=? orderId1 - Just _ -> assertFailure "Invalid response" - Nothing -> assertFailure "Invalid response" + Just ResponseOk -> return () + Just _ -> assertFailure "Invalid response" + Nothing -> assertFailure "Invalid response" step "Reading response for identity2" resp <- decode . BL.fromStrict <$> receive sock2 case resp of - Just (ResponseOrderSubmitted localOrderId) -> localOrderId @=? orderId2 - Just _ -> assertFailure "Invalid response" - Nothing -> assertFailure "Invalid response" + Just ResponseOk -> return () + Just _ -> assertFailure "Invalid response" + Nothing -> assertFailure "Invalid response" testBrokerServerSubmitOrderToUnknownAccount :: TestTree testBrokerServerSubmitOrderToUnknownAccount = testCaseSteps "Broker Server returns error if account is unknown" $ @@ -178,11 +178,10 @@ testBrokerServerCancelOrder = testCaseSteps "Broker Server: submitted order canc bracket (startBrokerServer [mockBroker] ctx ep notifEp [] defaultServerSecurityParams) stopBrokerServer $ \_ -> withSocket ctx Req $ \sock -> do connectAndSendOrder step sock defaultOrder ep - (Just (ResponseOrderSubmitted localOrderId)) <- decode . BL.fromStrict <$> receive sock - localOrderId @=? (orderId defaultOrder) + Just ResponseOk <- decode . BL.fromStrict <$> receive sock step "Sending order cancellation request" - send sock [] (BL.toStrict . encode $ RequestCancelOrder 2 "identity" localOrderId) + send sock [] (BL.toStrict . encode $ RequestCancelOrder 2 "identity" (orderId defaultOrder)) threadDelay 10000 step "Checking that order is cancelled in BrokerBackend" @@ -192,9 +191,9 @@ testBrokerServerCancelOrder = testCaseSteps "Broker Server: submitted order canc step "Reading response" resp <- decode . BL.fromStrict <$> receive sock case resp of - Just (ResponseOrderCancelled _) -> return () - Just _ -> assertFailure "Invalid response" - Nothing -> assertFailure "Invalid response" + Just ResponseOk -> return () + Just _ -> assertFailure "Invalid response" + Nothing -> assertFailure "Invalid response" testBrokerServerCancelUnknownOrder :: TestTree testBrokerServerCancelUnknownOrder = testCaseSteps "Broker Server: order cancellation: error if order is unknown" $ @@ -255,8 +254,7 @@ testBrokerServerGetNotifications = testCaseSteps "Broker Server: notifications r -- We have to actually submit order, or else server won't know that we should -- be notified about this order connectAndSendOrder step sock defaultOrder ep - (Just (ResponseOrderSubmitted localOrderId)) <- decode . BL.fromStrict <$> receive sock - localOrderId @=? orderId defaultOrder + Just ResponseOk <- decode . BL.fromStrict <$> receive sock threadDelay 10000 globalOrderId <- orderId . head . orders <$> readIORef broState @@ -292,9 +290,8 @@ testBrokerServerGetNotifications = testCaseSteps "Broker Server: notifications r length ns @=? 3 let (OrderNotification orderNotificationSqnum oid newstate) = ns !! 1 let (TradeNotification tradeNotificationSqnum newtrade) = ns !! 2 - localOrderId @=? oid Executed @=? newstate - trade { tradeOrderId = localOrderId } @=? newtrade + trade { tradeOrderId = orderId defaultOrder } @=? newtrade -- Check notification sqnums step "Received notification sqnums are correct" let sqnums = sort $ fmap (unNotificationSqnum . getNotificationSqnum) ns @@ -313,8 +310,7 @@ testBrokerServerGetNotificationsFromSameSqnum = testCaseSteps "Broker Server: no bracket (startBrokerServer [mockBroker] ctx ep notifEp [] defaultServerSecurityParams) stopBrokerServer $ \_ -> withSocket ctx Req $ \sock -> do connectAndSendOrder step sock defaultOrder ep - (Just (ResponseOrderSubmitted localOrderId)) <- decode . BL.fromStrict <$> receive sock - localOrderId @=? orderId defaultOrder + Just ResponseOk <- decode . BL.fromStrict <$> receive sock threadDelay 10000 globalOrderId <- orderId . head . orders <$> readIORef broState @@ -372,8 +368,7 @@ testBrokerServerGetNotificationsRemovesEarlierNotifications = testCaseSteps "Bro bracket (startBrokerServer [mockBroker] ctx ep notifEp [] defaultServerSecurityParams) stopBrokerServer $ \_ -> withSocket ctx Req $ \sock -> do connectAndSendOrder step sock defaultOrder ep - (Just (ResponseOrderSubmitted localOrderId)) <- decode . BL.fromStrict <$> receive sock - localOrderId @=? orderId defaultOrder + Just ResponseOk <- decode . BL.fromStrict <$> receive sock threadDelay 10000 globalOrderId <- orderId . head . orders <$> readIORef broState @@ -428,7 +423,7 @@ testBrokerServerDuplicateRequest = testCaseSteps "Broker Server: duplicate reque connectAndSendOrder step sock defaultOrder ep step "Reading response" - (Just (ResponseOrderSubmitted orderId)) <- decode . BL.fromStrict <$> receive sock + Just ResponseOk <- decode . BL.fromStrict <$> receive sock step "Sending duplicate request (with same sequence number)" send sock [] (BL.toStrict . encode $ RequestSubmitOrder 1 "identity" defaultOrder) @@ -441,9 +436,9 @@ testBrokerServerDuplicateRequest = testCaseSteps "Broker Server: duplicate reque step "Reading response from duplicate request" resp <- decode . BL.fromStrict <$> receive sock case resp of - Just (ResponseOrderSubmitted oid) -> orderId @?= oid - Just _ -> assertFailure "Invalid response" - Nothing -> assertFailure "Invalid response" + Just ResponseOk -> return () + Just _ -> assertFailure "Invalid response" + Nothing -> assertFailure "Invalid response" testBrokerServerNotificationSocket :: TestTree testBrokerServerNotificationSocket = testCaseSteps "Broker Server: sends notification via notification socket" $ \step -> withContext $ \ctx -> do @@ -459,13 +454,13 @@ testBrokerServerNotificationSocket = testCaseSteps "Broker Server: sends notific connectAndSendOrderWithIdentity step sock defaultOrder "test-identity" ep step "Reading response" - (Just (ResponseOrderSubmitted orderId)) <- decode . BL.fromStrict <$> receive sock + Just ResponseOk <- decode . BL.fromStrict <$> receive sock step "Reading order submitted notification" [_, payload] <- receiveMulti nSocket let (Just (OrderNotification notifSqnum1 notifOid newOrderState)) = decode . BL.fromStrict $ payload - notifOid @?= orderId + notifOid @?= orderId defaultOrder newOrderState @?= Submitted backendOrderId <- mockBrokerLastOrderId broState @@ -489,7 +484,7 @@ testBrokerServerNotificationSocket = testCaseSteps "Broker Server: sends notific step "Receiving trade notification" [_, payload] <- receiveMulti nSocket let (Just (TradeNotification notifSqnum2 incomingTrade)) = decode . BL.fromStrict $ payload - incomingTrade @?= trade { tradeOrderId = orderId } + incomingTrade @?= trade { tradeOrderId = orderId defaultOrder } {- testBrokerServerTradeSink :: TestTree