asakul
/
libatrade
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
Browse Source

testing(BrokerServer): more tests for RequestNotifications

master
Denis Tereshkin 4 years ago
parent
3065547ce4
commit
57d6e4fc2b
5 changed files with 173 additions and 58 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Unified View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 76
      src/ATrade/Broker/Client.hs
  2. 26
      src/ATrade/Broker/Protocol.hs
  3. 7
      src/ATrade/Broker/Server.hs
  4. 2
      test/ArbitraryInstances.hs
  5. 120
      test/TestBrokerServer.hs

76
src/ATrade/Broker/Client.hs
Unescape View File

@ -8,38 +8,38 @@ module ATrade.Broker.Client (
getNotifications getNotifications
) where ) where
import ATrade.Types import ATrade.Broker.Protocol
import ATrade.Broker.Protocol import ATrade.Types
import Control.Concurrent hiding (readChan, writeChan) import Control.Concurrent hiding (readChan, writeChan)
import Control.Concurrent.BoundedChan import Control.Concurrent.BoundedChan
import Control.Concurrent.MVar import Control.Concurrent.MVar
import Control.Exception import Control.Exception
import Control.Monad import Control.Monad
import Control.Monad.Loops import Control.Monad.Loops
import Data.Aeson import Data.Aeson
import Data.Int import qualified Data.ByteString as B
import Data.IORef import qualified Data.ByteString.Lazy as BL
import Data.Maybe import Data.Int
import Data.List.NonEmpty import Data.IORef
import qualified Data.List as L import qualified Data.List as L
import qualified Data.Text as T import Data.List.NonEmpty
import qualified Data.ByteString as B import Data.Maybe
import qualified Data.ByteString.Lazy as BL import qualified Data.Text as T
import Data.Text.Encoding import Data.Text.Encoding
import System.ZMQ4 import System.Log.Logger
import System.ZMQ4.ZAP import System.Timeout
import System.Log.Logger import System.ZMQ4
import System.Timeout import System.ZMQ4.ZAP
data BrokerClientHandle = BrokerClientHandle { data BrokerClientHandle = BrokerClientHandle {
tid :: ThreadId, tid :: ThreadId,
completionMvar :: MVar (), completionMvar :: MVar (),
killMvar :: MVar (), killMvar :: MVar (),
submitOrder :: Order -> IO (Either T.Text OrderId), submitOrder :: Order -> IO (Either T.Text OrderId),
cancelOrder :: OrderId -> IO (Either T.Text ()), cancelOrder :: OrderId -> IO (Either T.Text ()),
getNotifications :: IO (Either T.Text [Notification]), getNotifications :: IO (Either T.Text [Notification]),
cmdVar :: MVar BrokerServerRequest, cmdVar :: MVar BrokerServerRequest,
respVar :: MVar BrokerServerResponse respVar :: MVar BrokerServerResponse
} }
brokerClientThread :: B.ByteString -> Context -> T.Text -> MVar BrokerServerRequest -> MVar BrokerServerResponse -> MVar () -> MVar () -> ClientSecurityParams -> IO () brokerClientThread :: B.ByteString -> Context -> T.Text -> MVar BrokerServerRequest -> MVar BrokerServerResponse -> MVar () -> MVar () -> ClientSecurityParams -> IO ()
@ -60,10 +60,10 @@ brokerClientThread socketIdentity ctx ep cmd resp comp killMv secParams = finall
debugM "Broker.Client" $ "Connecting to: " ++ show (T.unpack ep) debugM "Broker.Client" $ "Connecting to: " ++ show (T.unpack ep)
case cspCertificate secParams of case cspCertificate secParams of
Just clientCert -> zapApplyCertificate clientCert sock Just clientCert -> zapApplyCertificate clientCert sock
Nothing -> return () Nothing -> return ()
case cspServerCertificate secParams of case cspServerCertificate secParams of
Just serverCert -> zapSetServerCertificate serverCert sock Just serverCert -> zapSetServerCertificate serverCert sock
Nothing -> return () Nothing -> return ()
connect sock $ T.unpack ep connect sock $ T.unpack ep
debugM "Broker.Client" $ "Connected" debugM "Broker.Client" $ "Connected"
@ -115,8 +115,8 @@ bcSubmitOrder clientIdentity idCounter cmdVar respVar order = do
resp <- takeMVar respVar resp <- takeMVar respVar
case resp of case resp of
(ResponseOrderSubmitted oid) -> return $ Right oid (ResponseOrderSubmitted oid) -> return $ Right oid
(ResponseError msg) -> return $ Left msg (ResponseError msg) -> return $ Left msg
_ -> return $ Left "Unknown error" _ -> return $ Left "Unknown error"
bcCancelOrder :: ClientIdentity -> IORef RequestSqnum -> MVar BrokerServerRequest -> MVar BrokerServerResponse -> OrderId -> IO (Either T.Text ()) bcCancelOrder :: ClientIdentity -> IORef RequestSqnum -> MVar BrokerServerRequest -> MVar BrokerServerResponse -> OrderId -> IO (Either T.Text ())
bcCancelOrder clientIdentity idCounter cmdVar respVar orderId = do bcCancelOrder clientIdentity idCounter cmdVar respVar orderId = do
@ -125,15 +125,15 @@ bcCancelOrder clientIdentity idCounter cmdVar respVar orderId = do
resp <- takeMVar respVar resp <- takeMVar respVar
case resp of case resp of
(ResponseOrderCancelled oid) -> return $ Right () (ResponseOrderCancelled oid) -> return $ Right ()
(ResponseError msg) -> return $ Left msg (ResponseError msg) -> return $ Left msg
_ -> return $ Left "Unknown error" _ -> return $ Left "Unknown error"
bcGetNotifications :: ClientIdentity -> IORef RequestSqnum -> MVar BrokerServerRequest -> MVar BrokerServerResponse -> IO (Either T.Text [Notification]) bcGetNotifications :: ClientIdentity -> IORef RequestSqnum -> MVar BrokerServerRequest -> MVar BrokerServerResponse -> IO (Either T.Text [Notification])
bcGetNotifications clientIdentity idCounter cmdVar respVar = do bcGetNotifications clientIdentity idCounter cmdVar respVar = do
sqnum <- nextId idCounter sqnum <- nextId idCounter
putMVar cmdVar (RequestNotifications sqnum clientIdentity) putMVar cmdVar (RequestNotifications sqnum clientIdentity (NotificationSqnum 0))
resp <- takeMVar respVar resp <- takeMVar respVar
case resp of case resp of
(ResponseNotifications ns) -> return $ Right ns (ResponseNotifications ns) -> return $ Right ns
(ResponseError msg) -> return $ Left msg (ResponseError msg) -> return $ Left msg
_ -> return $ Left "Unknown error" _ -> return $ Left "Unknown error"

26
src/ATrade/Broker/Protocol.hs
Unescape View File

@ -9,6 +9,7 @@ module ATrade.Broker.Protocol (
Notification(..), Notification(..),
NotificationSqnum(..), NotificationSqnum(..),
nextSqnum, nextSqnum,
getNotificationSqnum,
notificationOrderId, notificationOrderId,
RequestSqnum(..), RequestSqnum(..),
requestSqnum, requestSqnum,
@ -35,7 +36,7 @@ type ClientIdentity = T.Text
type RequestSqnum = Int64 type RequestSqnum = Int64
newtype NotificationSqnum = NotificationSqnum { unNotificationSqnum :: Int64 } newtype NotificationSqnum = NotificationSqnum { unNotificationSqnum :: Int64 }
deriving (Eq, Show) deriving (Eq, Show, Ord)
nextSqnum :: NotificationSqnum -> NotificationSqnum nextSqnum :: NotificationSqnum -> NotificationSqnum
nextSqnum (NotificationSqnum n) = NotificationSqnum (n + 1) nextSqnum (NotificationSqnum n) = NotificationSqnum (n + 1)
@ -43,9 +44,9 @@ nextSqnum (NotificationSqnum n) = NotificationSqnum (n + 1)
data Notification = OrderNotification NotificationSqnum OrderId OrderState | TradeNotification NotificationSqnum Trade data Notification = OrderNotification NotificationSqnum OrderId OrderState | TradeNotification NotificationSqnum Trade
deriving (Eq, Show) deriving (Eq, Show)
notificationSqnum :: Notification -> NotificationSqnum getNotificationSqnum :: Notification -> NotificationSqnum
notificationSqnum (OrderNotification sqnum _ _) = sqnum getNotificationSqnum (OrderNotification sqnum _ _) = sqnum
notificationSqnum (TradeNotification sqnum _) = sqnum getNotificationSqnum (TradeNotification sqnum _) = sqnum
notificationOrderId :: Notification -> OrderId notificationOrderId :: Notification -> OrderId
notificationOrderId (OrderNotification _ oid _) = oid notificationOrderId (OrderNotification _ oid _) = oid
@ -78,13 +79,13 @@ instance ToJSON Notification where
data BrokerServerRequest = RequestSubmitOrder RequestSqnum ClientIdentity Order data BrokerServerRequest = RequestSubmitOrder RequestSqnum ClientIdentity Order
| RequestCancelOrder RequestSqnum ClientIdentity OrderId | RequestCancelOrder RequestSqnum ClientIdentity OrderId
| RequestNotifications RequestSqnum ClientIdentity | RequestNotifications RequestSqnum ClientIdentity NotificationSqnum
deriving (Eq, Show) deriving (Eq, Show)
requestSqnum :: BrokerServerRequest -> RequestSqnum requestSqnum :: BrokerServerRequest -> RequestSqnum
requestSqnum (RequestSubmitOrder sqnum _ _) = sqnum requestSqnum (RequestSubmitOrder sqnum _ _) = sqnum
requestSqnum (RequestCancelOrder sqnum _ _) = sqnum requestSqnum (RequestCancelOrder sqnum _ _) = sqnum
requestSqnum (RequestNotifications sqnum _) = sqnum requestSqnum (RequestNotifications sqnum _ _) = sqnum
instance FromJSON BrokerServerRequest where instance FromJSON BrokerServerRequest where
parseJSON = withObject "object" (\obj -> do parseJSON = withObject "object" (\obj -> do
@ -100,7 +101,9 @@ instance FromJSON BrokerServerRequest where
| HM.member "cancel-order" obj = do | HM.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 = return (RequestNotifications sqnum clientIdentity) | HM.member "request-notifications" obj = do
initialSqnum <- obj .: "initial-sqnum"
return (RequestNotifications sqnum clientIdentity (NotificationSqnum initialSqnum))
parseRequest _ _ _ = fail "Invalid request object" parseRequest _ _ _ = fail "Invalid request object"
instance ToJSON BrokerServerRequest where instance ToJSON BrokerServerRequest where
@ -110,9 +113,10 @@ instance ToJSON BrokerServerRequest where
toJSON (RequestCancelOrder sqnum clientIdentity oid) = object ["request-sqnum" .= sqnum, toJSON (RequestCancelOrder sqnum clientIdentity oid) = object ["request-sqnum" .= sqnum,
"client-identity" .= clientIdentity, "client-identity" .= clientIdentity,
"cancel-order" .= oid ] "cancel-order" .= oid ]
toJSON (RequestNotifications sqnum clientIdentity) = object ["request-sqnum" .= sqnum, toJSON (RequestNotifications sqnum clientIdentity initialNotificationSqnum) = object ["request-sqnum" .= sqnum,
"client-identity" .= clientIdentity, "client-identity" .= clientIdentity,
"request-notifications" .= ("" :: T.Text) ] "request-notifications" .= ("" :: T.Text),
"initial-sqnum" .= unNotificationSqnum initialNotificationSqnum]
data BrokerServerResponse = ResponseOrderSubmitted OrderId data BrokerServerResponse = ResponseOrderSubmitted OrderId
| ResponseOrderCancelled OrderId | ResponseOrderCancelled OrderId

7
src/ATrade/Broker/Server.hs
Unescape View File

@ -203,12 +203,13 @@ brokerServerThread state = finally brokerServerThread' cleanup
cancelOrder bro globalOrderId cancelOrder bro globalOrderId
return $ ResponseOrderCancelled localOrderId return $ ResponseOrderCancelled localOrderId
_ -> return $ ResponseError "Unknown order" _ -> return $ ResponseError "Unknown order"
RequestNotifications sqnum clientIdentity -> do RequestNotifications sqnum clientIdentity initialSqnum -> do
maybeNs <- M.lookup clientIdentity . pendingNotifications <$> readIORef state maybeNs <- M.lookup clientIdentity . pendingNotifications <$> readIORef state
case maybeNs of case maybeNs of
Just ns -> do Just ns -> do
atomicMapIORef state (\s -> s { pendingNotifications = M.insert clientIdentity [] (pendingNotifications s)}) let filtered = L.filter (\n -> getNotificationSqnum n >= initialSqnum) ns
return $ ResponseNotifications . L.reverse $ ns atomicMapIORef state (\s -> s { pendingNotifications = M.insert clientIdentity filtered (pendingNotifications s)})
return $ ResponseNotifications . L.reverse $ filtered
Nothing -> return $ ResponseNotifications [] Nothing -> return $ ResponseNotifications []
sendMessage sock peerId resp = sendMulti sock (peerId :| [B.empty, BL.toStrict . encode $ resp]) sendMessage sock peerId resp = sendMulti sock (peerId :| [B.empty, BL.toStrict . encode $ resp])

2
test/ArbitraryInstances.hs
Unescape View File

@ -112,7 +112,7 @@ instance Arbitrary BrokerServerRequest where
t <- choose (1, 3) :: Gen Int t <- choose (1, 3) :: Gen Int
if | t == 1 -> RequestSubmitOrder <$> arbitrary <*> arbitrary <*> arbitrary if | t == 1 -> RequestSubmitOrder <$> arbitrary <*> arbitrary <*> arbitrary
| t == 2 -> RequestCancelOrder <$> arbitrary <*> arbitrary <*> arbitrary | t == 2 -> RequestCancelOrder <$> arbitrary <*> arbitrary <*> arbitrary
| t == 3 -> RequestNotifications <$> arbitrary <*> arbitrary | t == 3 -> RequestNotifications <$> arbitrary <*> arbitrary <*> arbitrary
instance Arbitrary BrokerServerResponse where instance Arbitrary BrokerServerResponse where
arbitrary = do arbitrary = do

120
test/TestBrokerServer.hs
Unescape View File

@ -18,6 +18,7 @@ import Data.Aeson
import qualified Data.ByteString as B import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy as BL
import Data.IORef import Data.IORef
import Data.List (sort)
import qualified Data.Text as T import qualified Data.Text as T
import Data.Time.Calendar import Data.Time.Calendar
import Data.Time.Clock import Data.Time.Clock
@ -35,6 +36,8 @@ unitTests = testGroup "Broker.Server" [testBrokerServerStartStop
, testBrokerServerCancelUnknownOrder , testBrokerServerCancelUnknownOrder
, testBrokerServerCorruptedPacket , testBrokerServerCorruptedPacket
, testBrokerServerGetNotifications , testBrokerServerGetNotifications
, testBrokerServerGetNotificationsFromSameSqnum
, testBrokerServerGetNotificationsRemovesEarlierNotifications
, testBrokerServerDuplicateRequest ] , testBrokerServerDuplicateRequest ]
-- --
@ -271,7 +274,7 @@ testBrokerServerGetNotifications = testCaseSteps "Broker Server: notifications r
cb (BackendTradeNotification trade) cb (BackendTradeNotification trade)
step "Sending notifications request" step "Sending notifications request"
send sock [] (BL.toStrict . encode $ RequestNotifications 2 "identity") send sock [] (BL.toStrict . encode $ RequestNotifications 2 "identity" (NotificationSqnum 1))
threadDelay 10000 threadDelay 10000
-- We should obtain 3 notifications: -- We should obtain 3 notifications:
@ -288,21 +291,128 @@ testBrokerServerGetNotifications = testCaseSteps "Broker Server: notifications r
localOrderId @=? oid localOrderId @=? oid
Executed @=? newstate Executed @=? newstate
trade { tradeOrderId = localOrderId } @=? newtrade trade { tradeOrderId = localOrderId } @=? newtrade
-- Check notification sqnums
step "Received notification sqnums are correct"
let sqnums = sort $ fmap (unNotificationSqnum . getNotificationSqnum) ns
sqnums @=? [1, 2, 3]
Just _ -> assertFailure "Invalid response" Just _ -> assertFailure "Invalid response"
Nothing -> assertFailure "Invalid response" Nothing -> assertFailure "Invalid response"
testBrokerServerGetNotificationsFromSameSqnum :: TestTree
testBrokerServerGetNotificationsFromSameSqnum = testCaseSteps "Broker Server: notifications request, twice from same sqnum" $
\step -> withContext $ \ctx -> do
step "Setup"
ep <- makeEndpoint
(mockBroker, broState) <- mkMockBroker ["demo"]
bracket (startBrokerServer [mockBroker] ctx ep [] defaultServerSecurityParams) stopBrokerServer $ \_ ->
withSocket ctx Req $ \sock -> do
connectAndSendOrder step sock defaultOrder ep
(Just (ResponseOrderSubmitted localOrderId)) <- decode . BL.fromStrict <$> receive sock
localOrderId @=? orderId defaultOrder
threadDelay 10000
globalOrderId <- orderId . head . orders <$> readIORef broState
(Just cb) <- notificationCallback <$> readIORef broState
cb (BackendOrderNotification globalOrderId Executed)
let trade = Trade {
tradeOrderId = globalOrderId,
tradePrice = 19.82,
tradeQuantity = 1,
tradeVolume = 1982,
tradeVolumeCurrency = "TEST_CURRENCY",
tradeOperation = Buy,
tradeAccount = "demo",
tradeSecurity = "FOO",
tradeTimestamp = UTCTime (fromGregorian 2016 9 28) 16000,
tradeCommission = 0,
tradeSignalId = SignalId "Foo" "bar" "baz" }
cb (BackendTradeNotification trade)
step "Sending notifications request"
send sock [] (BL.toStrict . encode $ RequestNotifications 2 "identity" (NotificationSqnum 1))
threadDelay 10000
step "Reading response"
resp <- decode . BL.fromStrict <$> receive sock
case resp of
Just (ResponseNotifications ns) -> do
step "Received notification sqnums are correct"
let sqnums = sort $ fmap (unNotificationSqnum . getNotificationSqnum) ns
sqnums @=? [1, 2, 3]
_ -> assertFailure "Invalid response"
step "Sending second notifications request" step "Sending second notifications request"
send sock [] (BL.toStrict . encode $ RequestNotifications 3 "identity") send sock [] (BL.toStrict . encode $ RequestNotifications 3 "identity" (NotificationSqnum 1))
threadDelay 10000 threadDelay 10000
step "Reading response" step "Reading response"
resp' <- decode . BL.fromStrict <$> receive sock resp' <- decode . BL.fromStrict <$> receive sock
case resp' of case resp' of
Just (ResponseNotifications ns) -> do Just (ResponseNotifications ns) -> do
0 @=? length ns step "Received notification sqnums are correct"
Just _ -> assertFailure "Invalid response" let sqnums = sort $ fmap (unNotificationSqnum . getNotificationSqnum) ns
Nothing -> assertFailure "Invalid response" [1, 2, 3] @=? sqnums
_ -> assertFailure "Invalid response"
testBrokerServerGetNotificationsRemovesEarlierNotifications :: TestTree
testBrokerServerGetNotificationsRemovesEarlierNotifications = testCaseSteps "Broker Server: notifications request removes earlier notifications" $
\step -> withContext $ \ctx -> do
step "Setup"
ep <- makeEndpoint
(mockBroker, broState) <- mkMockBroker ["demo"]
bracket (startBrokerServer [mockBroker] ctx ep [] defaultServerSecurityParams) stopBrokerServer $ \_ ->
withSocket ctx Req $ \sock -> do
connectAndSendOrder step sock defaultOrder ep
(Just (ResponseOrderSubmitted localOrderId)) <- decode . BL.fromStrict <$> receive sock
localOrderId @=? orderId defaultOrder
threadDelay 10000
globalOrderId <- orderId . head . orders <$> readIORef broState
(Just cb) <- notificationCallback <$> readIORef broState
cb (BackendOrderNotification globalOrderId Executed)
let trade = Trade {
tradeOrderId = globalOrderId,
tradePrice = 19.82,
tradeQuantity = 1,
tradeVolume = 1982,
tradeVolumeCurrency = "TEST_CURRENCY",
tradeOperation = Buy,
tradeAccount = "demo",
tradeSecurity = "FOO",
tradeTimestamp = UTCTime (fromGregorian 2016 9 28) 16000,
tradeCommission = 0,
tradeSignalId = SignalId "Foo" "bar" "baz" }
cb (BackendTradeNotification trade)
step "Sending notifications request"
send sock [] (BL.toStrict . encode $ RequestNotifications 2 "identity" (NotificationSqnum 4))
threadDelay 10000
step "Reading response"
resp <- decode . BL.fromStrict <$> receive sock
case resp of
Just (ResponseNotifications ns) -> do
step "Checking that request list is empty"
[] @=? ns
_ -> assertFailure "Invalid response"
step "Sending second notifications request"
send sock [] (BL.toStrict . encode $ RequestNotifications 3 "identity" (NotificationSqnum 1))
threadDelay 10000
step "Reading response"
resp' <- decode . BL.fromStrict <$> receive sock
case resp' of
Just (ResponseNotifications ns) -> do
step "Checking that request list is empty"
[] @=? ns
_ -> assertFailure "Invalid response"
testBrokerServerDuplicateRequest :: TestTree testBrokerServerDuplicateRequest :: TestTree
testBrokerServerDuplicateRequest = testCaseSteps "Broker Server: duplicate request" $ \step -> withContext $ \ctx -> do testBrokerServerDuplicateRequest = testCaseSteps "Broker Server: duplicate request" $ \step -> withContext $ \ctx -> do

Write Preview
Loading…
Cancel
Save