BrokerClient: order cancellation

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
+
 

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()
+          )))
+