diff --git a/src/ATrade/Broker/Client.hs b/src/ATrade/Broker/Client.hs index 4656bad..c75287a 100644 --- a/src/ATrade/Broker/Client.hs +++ b/src/ATrade/Broker/Client.hs @@ -39,13 +39,14 @@ brokerClientThread ctx ep cmd resp comp = do finally (brokerClientThread' sock) (cleanup sock) where cleanup sock = close sock >> putMVar comp () - brokerClientThread' sock = forever $ do - request <- readMVar cmd - send sock [] (BL.toStrict $ encode request) - maybeResponse <- decode . BL.fromStrict <$> receive sock - case maybeResponse of - Just response -> putMVar resp response - Nothing -> putMVar resp (ResponseError "Unable to decode response") + brokerClientThread' sock = do + forever $ do + request <- takeMVar cmd + send sock [] (BL.toStrict $ encode request) + maybeResponse <- decode . BL.fromStrict <$> receive sock + case maybeResponse of + Just response -> putMVar resp response + Nothing -> putMVar resp (ResponseError "Unable to decode response") startBrokerClient :: Context -> T.Text -> IO BrokerClientHandle startBrokerClient ctx endpoint = do @@ -73,11 +74,20 @@ bcSubmitOrder :: IORef Int64 -> MVar BrokerServerRequest -> MVar BrokerServerRes bcSubmitOrder idCounter cmdVar respVar order = do sqnum <- nextId idCounter putMVar cmdVar (RequestSubmitOrder sqnum order) - resp <- readMVar respVar + resp <- takeMVar respVar case resp of (ResponseOrderSubmitted oid) -> return $ Right oid + _ -> return $ Left "Unknown error" (ResponseError msg) -> return $ Left msg -bcCancelOrder idCounter cmdVar respVar orderId = undefined +bcCancelOrder idCounter cmdVar respVar orderId = do + sqnum <- nextId idCounter + putMVar cmdVar (RequestCancelOrder sqnum orderId) + resp <- takeMVar respVar + case resp of + (ResponseOrderCancelled oid) -> return $ Right () + _ -> return $ Left "Unknown error" + (ResponseError msg) -> return $ Left msg + diff --git a/test/TestBrokerClient.hs b/test/TestBrokerClient.hs index ab5b95d..3954e6c 100644 --- a/test/TestBrokerClient.hs +++ b/test/TestBrokerClient.hs @@ -14,7 +14,7 @@ import ATrade.Types import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import ATrade.Broker.Client -import ATrade.Broker.Server hiding (submitOrder) +import ATrade.Broker.Server hiding (submitOrder, cancelOrder) import ATrade.Broker.Protocol import ATrade.Util import qualified Data.Text as T @@ -35,7 +35,10 @@ import Data.UUID as U import Data.UUID.V4 as UV4 import MockBroker -unitTests = testGroup "Broker.Client" [testBrokerClientStartStop] +unitTests = testGroup "Broker.Client" [ + testBrokerClientStartStop + , testBrokerClientCancelOrder + ] makeEndpoint = do uid <- toText <$> UV4.nextRandom @@ -59,3 +62,18 @@ testBrokerClientStartStop = testCase "Broker client: submit order" $ withContext Left err -> assertFailure "Invalid response" Right _ -> return ()))) +testBrokerClientCancelOrder = testCase "Broker client: submit and cancel order" $ withContext (\ctx -> do + ep <- makeEndpoint + (mockBroker, broState) <- mkMockBroker ["demo"] + bracket (startBrokerServer [mockBroker] ctx ep) stopBrokerServer (\broS -> + bracket (startBrokerClient ctx ep) stopBrokerClient (\broC -> do + maybeOid <- submitOrder broC defaultOrder + case maybeOid of + Left err -> assertFailure "Invalid response" + Right oid -> do + rc <- cancelOrder broC oid + case rc of + Left err -> assertFailure "Invalid response" + Right _ -> return() + ))) +