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

Fix tests: BrokerServer & BrokerClient

master
Denis Tereshkin 4 years ago
parent
9c95b7291a
commit
b66fa9f55b
3 changed files with 27 additions and 20 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. 9
      src/ATrade/Logging.hs
  2. 13
      test/TestBrokerClient.hs
  3. 25
      test/TestBrokerServer.hs

9
src/ATrade/Logging.hs
Unescape View File

@ -2,6 +2,7 @@
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE RankNTypes #-}
module ATrade.Logging module ATrade.Logging
( (
@ -20,10 +21,11 @@ module ATrade.Logging
logDebugWith, logDebugWith,
logInfoWith, logInfoWith,
logWarningWith, logWarningWith,
logErrorWith logErrorWith,
emptyLogger
) where ) where
import Colog (LogAction (unLogAction), WithLog, import Colog (LogAction (unLogAction, LogAction), WithLog,
logMsg) logMsg)
import Control.Monad.IO.Class (MonadIO (liftIO)) import Control.Monad.IO.Class (MonadIO (liftIO))
import qualified Data.Text as T import qualified Data.Text as T
@ -54,6 +56,9 @@ data Message =
msgText :: T.Text msgText :: T.Text
} deriving (Show, Eq) } deriving (Show, Eq)
emptyLogger :: forall m. (MonadIO m) => LogAction m Message
emptyLogger = LogAction (const $ return ())
fmtMessage :: Message -> T.Text fmtMessage :: Message -> T.Text
fmtMessage Message{..} = fmtMessage Message{..} =
(bracketed . T.pack . formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S") msgTimestamp <> (bracketed . T.pack . formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S") msgTimestamp <>

13
test/TestBrokerClient.hs
Unescape View File

@ -15,6 +15,7 @@ import ATrade.Broker.Protocol
import ATrade.Broker.Server hiding (cancelOrder, import ATrade.Broker.Server hiding (cancelOrder,
submitOrder) submitOrder)
import ATrade.Types import ATrade.Types
import ATrade.Logging (emptyLogger)
import ATrade.Util import ATrade.Util
import Control.Concurrent hiding (writeChan) import Control.Concurrent hiding (writeChan)
import Control.Concurrent.BoundedChan import Control.Concurrent.BoundedChan
@ -64,8 +65,8 @@ testBrokerClientStartStop = testCase "Broker client: submit order" $ withContext
(ep, notifEp) <- makeEndpoints (ep, notifEp) <- makeEndpoints
(ref, callback) <- makeNotificationCallback (ref, callback) <- makeNotificationCallback
(mockBroker, broState) <- mkMockBroker ["demo"] (mockBroker, broState) <- mkMockBroker ["demo"]
bracket (startBrokerServer [mockBroker] ctx ep notifEp [] defaultServerSecurityParams) stopBrokerServer (\broS -> bracket (startBrokerServer [mockBroker] ctx ep notifEp [] defaultServerSecurityParams emptyLogger) stopBrokerServer (\broS ->
bracket (startBrokerClient "foo" ctx ep notifEp [callback] defaultClientSecurityParams) stopBrokerClient (\broC -> do bracket (startBrokerClient "foo" ctx ep notifEp [callback] defaultClientSecurityParams emptyLogger) stopBrokerClient (\broC -> do
result <- submitOrder broC defaultOrder result <- submitOrder broC defaultOrder
case result of case result of
Left err -> assertFailure "Invalid response" Left err -> assertFailure "Invalid response"
@ -83,8 +84,8 @@ testBrokerClientCancelOrder = testCase "Broker client: submit and cancel order"
(ep, notifEp) <- makeEndpoints (ep, notifEp) <- makeEndpoints
(ref, callback) <- makeNotificationCallback (ref, callback) <- makeNotificationCallback
(mockBroker, broState) <- mkMockBroker ["demo"] (mockBroker, broState) <- mkMockBroker ["demo"]
bracket (startBrokerServer [mockBroker] ctx ep notifEp [] defaultServerSecurityParams) stopBrokerServer (\broS -> bracket (startBrokerServer [mockBroker] ctx ep notifEp [] defaultServerSecurityParams emptyLogger) stopBrokerServer (\broS ->
bracket (startBrokerClient "foo" ctx ep notifEp [callback] defaultClientSecurityParams) stopBrokerClient (\broC -> do bracket (startBrokerClient "foo" ctx ep notifEp [callback] defaultClientSecurityParams emptyLogger) stopBrokerClient (\broC -> do
maybeOid <- submitOrder broC defaultOrder maybeOid <- submitOrder broC defaultOrder
case maybeOid of case maybeOid of
Left err -> assertFailure "Invalid response" Left err -> assertFailure "Invalid response"
@ -99,8 +100,8 @@ testBrokerClientGetNotifications = testCase "Broker client: get notifications" $
(ep, notifEp) <- makeEndpoints (ep, notifEp) <- makeEndpoints
(ref, callback) <- makeNotificationCallback (ref, callback) <- makeNotificationCallback
(mockBroker, broState) <- mkMockBroker ["demo"] (mockBroker, broState) <- mkMockBroker ["demo"]
bracket (startBrokerServer [mockBroker] ctx ep notifEp [] defaultServerSecurityParams) stopBrokerServer (\broS -> bracket (startBrokerServer [mockBroker] ctx ep notifEp [] defaultServerSecurityParams emptyLogger) stopBrokerServer (\broS ->
bracket (startBrokerClient "foo" ctx ep notifEp [callback] defaultClientSecurityParams) stopBrokerClient (\broC -> do bracket (startBrokerClient "foo" ctx ep notifEp [callback] defaultClientSecurityParams emptyLogger) stopBrokerClient (\broC -> do
maybeOid <- submitOrder broC defaultOrder maybeOid <- submitOrder broC defaultOrder
case maybeOid of case maybeOid of
Left err -> assertFailure "Invalid response" Left err -> assertFailure "Invalid response"

25
test/TestBrokerServer.hs
Unescape View File

@ -12,6 +12,7 @@ import ATrade.Broker.Backend
import ATrade.Broker.Protocol import ATrade.Broker.Protocol
import ATrade.Broker.Server import ATrade.Broker.Server
import ATrade.Types import ATrade.Types
import ATrade.Logging (emptyLogger)
import Control.Concurrent hiding (writeChan) import Control.Concurrent hiding (writeChan)
import Control.Exception import Control.Exception
import Data.Aeson import Data.Aeson
@ -96,7 +97,7 @@ makeTestTradeSink = do
testBrokerServerStartStop :: TestTree testBrokerServerStartStop :: TestTree
testBrokerServerStartStop = testCase "Broker Server starts and stops" $ withContext (\ctx -> do testBrokerServerStartStop = testCase "Broker Server starts and stops" $ withContext (\ctx -> do
(ep, notifEp) <- makeEndpoints (ep, notifEp) <- makeEndpoints
broS <- startBrokerServer [] ctx ep notifEp [] defaultServerSecurityParams broS <- startBrokerServer [] ctx ep notifEp [] defaultServerSecurityParams emptyLogger
stopBrokerServer broS) stopBrokerServer broS)
testBrokerServerSubmitOrder :: TestTree testBrokerServerSubmitOrder :: TestTree
@ -104,7 +105,7 @@ testBrokerServerSubmitOrder = testCaseSteps "Broker Server submits order" $ \ste
step "Setup" step "Setup"
(mockBroker, broState) <- mkMockBroker ["demo"] (mockBroker, broState) <- mkMockBroker ["demo"]
(ep, notifEp) <- makeEndpoints (ep, notifEp) <- makeEndpoints
bracket (startBrokerServer [mockBroker] ctx ep notifEp [] defaultServerSecurityParams) stopBrokerServer $ \_ -> do bracket (startBrokerServer [mockBroker] ctx ep notifEp [] defaultServerSecurityParams emptyLogger) stopBrokerServer $ \_ -> do
withSocket ctx Req $ \sock -> do withSocket ctx Req $ \sock -> do
connectAndSendOrder step sock defaultOrder ep connectAndSendOrder step sock defaultOrder ep
@ -126,7 +127,7 @@ testBrokerServerSubmitOrderDifferentIdentities = testCaseSteps "Broker Server su
(ep, notifEp) <- makeEndpoints (ep, notifEp) <- makeEndpoints
let orderId1 = 42 let orderId1 = 42
let orderId2 = 76 let orderId2 = 76
bracket (startBrokerServer [mockBroker] ctx ep notifEp [] defaultServerSecurityParams) stopBrokerServer $ \_ -> do bracket (startBrokerServer [mockBroker] ctx ep notifEp [] defaultServerSecurityParams emptyLogger) stopBrokerServer $ \_ -> do
withSocket ctx Req $ \sock1 -> do withSocket ctx Req $ \sock1 -> do
withSocket ctx Req $ \sock2 -> do withSocket ctx Req $ \sock2 -> do
connectAndSendOrderWithIdentity step sock1 defaultOrder {orderId = orderId1} "identity1" ep connectAndSendOrderWithIdentity step sock1 defaultOrder {orderId = orderId1} "identity1" ep
@ -156,7 +157,7 @@ testBrokerServerSubmitOrderToUnknownAccount = testCaseSteps "Broker Server retur
step "Setup" step "Setup"
(ep, notifEp) <- makeEndpoints (ep, notifEp) <- makeEndpoints
(mockBroker, _) <- mkMockBroker ["demo"] (mockBroker, _) <- mkMockBroker ["demo"]
bracket (startBrokerServer [mockBroker] ctx ep notifEp [] defaultServerSecurityParams) stopBrokerServer (\_ -> bracket (startBrokerServer [mockBroker] ctx ep notifEp [] defaultServerSecurityParams emptyLogger) stopBrokerServer (\_ ->
withSocket ctx Req (\sock -> do withSocket ctx Req (\sock -> do
connectAndSendOrder step sock (defaultOrder { orderAccountId = "foobar" }) ep connectAndSendOrder step sock (defaultOrder { orderAccountId = "foobar" }) ep
@ -175,7 +176,7 @@ testBrokerServerCancelOrder = testCaseSteps "Broker Server: submitted order canc
step "Setup" step "Setup"
(ep, notifEp) <- makeEndpoints (ep, notifEp) <- makeEndpoints
(mockBroker, broState) <- mkMockBroker ["demo"] (mockBroker, broState) <- mkMockBroker ["demo"]
bracket (startBrokerServer [mockBroker] ctx ep notifEp [] defaultServerSecurityParams) stopBrokerServer $ \_ -> bracket (startBrokerServer [mockBroker] ctx ep notifEp [] defaultServerSecurityParams emptyLogger) stopBrokerServer $ \_ ->
withSocket ctx Req $ \sock -> do withSocket ctx Req $ \sock -> do
connectAndSendOrder step sock defaultOrder ep connectAndSendOrder step sock defaultOrder ep
Just ResponseOk <- decode . BL.fromStrict <$> receive sock Just ResponseOk <- decode . BL.fromStrict <$> receive sock
@ -201,7 +202,7 @@ testBrokerServerCancelUnknownOrder = testCaseSteps "Broker Server: order cancell
step "Setup" step "Setup"
(ep, notifEp) <- makeEndpoints (ep, notifEp) <- makeEndpoints
(mockBroker, _) <- mkMockBroker ["demo"] (mockBroker, _) <- mkMockBroker ["demo"]
bracket (startBrokerServer [mockBroker] ctx ep notifEp [] defaultServerSecurityParams) stopBrokerServer (\_ -> bracket (startBrokerServer [mockBroker] ctx ep notifEp [] defaultServerSecurityParams emptyLogger) stopBrokerServer (\_ ->
withSocket ctx Req (\sock -> do withSocket ctx Req (\sock -> do
connectAndSendOrder step sock defaultOrder ep connectAndSendOrder step sock defaultOrder ep
receive sock receive sock
@ -224,7 +225,7 @@ testBrokerServerCorruptedPacket = testCaseSteps "Broker Server: corrupted packet
step "Setup" step "Setup"
(ep, notifEp) <- makeEndpoints (ep, notifEp) <- makeEndpoints
(mockBroker, _) <- mkMockBroker ["demo"] (mockBroker, _) <- mkMockBroker ["demo"]
bracket (startBrokerServer [mockBroker] ctx ep notifEp [] defaultServerSecurityParams) stopBrokerServer (\_ -> bracket (startBrokerServer [mockBroker] ctx ep notifEp [] defaultServerSecurityParams emptyLogger) stopBrokerServer (\_ ->
withSocket ctx Req (\sock -> do withSocket ctx Req (\sock -> do
step "Connecting" step "Connecting"
connect sock (T.unpack ep) connect sock (T.unpack ep)
@ -249,7 +250,7 @@ testBrokerServerGetNotifications = testCaseSteps "Broker Server: notifications r
step "Setup" step "Setup"
(ep, notifEp) <- makeEndpoints (ep, notifEp) <- makeEndpoints
(mockBroker, broState) <- mkMockBroker ["demo"] (mockBroker, broState) <- mkMockBroker ["demo"]
bracket (startBrokerServer [mockBroker] ctx ep notifEp [] defaultServerSecurityParams) stopBrokerServer $ \_ -> bracket (startBrokerServer [mockBroker] ctx ep notifEp [] defaultServerSecurityParams emptyLogger) stopBrokerServer $ \_ ->
withSocket ctx Req $ \sock -> do withSocket ctx Req $ \sock -> do
-- We have to actually submit order, or else server won't know that we should -- We have to actually submit order, or else server won't know that we should
-- be notified about this order -- be notified about this order
@ -307,7 +308,7 @@ testBrokerServerGetNotificationsFromSameSqnum = testCaseSteps "Broker Server: no
step "Setup" step "Setup"
(ep, notifEp) <- makeEndpoints (ep, notifEp) <- makeEndpoints
(mockBroker, broState) <- mkMockBroker ["demo"] (mockBroker, broState) <- mkMockBroker ["demo"]
bracket (startBrokerServer [mockBroker] ctx ep notifEp [] defaultServerSecurityParams) stopBrokerServer $ \_ -> bracket (startBrokerServer [mockBroker] ctx ep notifEp [] defaultServerSecurityParams emptyLogger) stopBrokerServer $ \_ ->
withSocket ctx Req $ \sock -> do withSocket ctx Req $ \sock -> do
connectAndSendOrder step sock defaultOrder ep connectAndSendOrder step sock defaultOrder ep
Just ResponseOk <- decode . BL.fromStrict <$> receive sock Just ResponseOk <- decode . BL.fromStrict <$> receive sock
@ -365,7 +366,7 @@ testBrokerServerGetNotificationsRemovesEarlierNotifications = testCaseSteps "Bro
step "Setup" step "Setup"
(ep, notifEp) <- makeEndpoints (ep, notifEp) <- makeEndpoints
(mockBroker, broState) <- mkMockBroker ["demo"] (mockBroker, broState) <- mkMockBroker ["demo"]
bracket (startBrokerServer [mockBroker] ctx ep notifEp [] defaultServerSecurityParams) stopBrokerServer $ \_ -> bracket (startBrokerServer [mockBroker] ctx ep notifEp [] defaultServerSecurityParams emptyLogger) stopBrokerServer $ \_ ->
withSocket ctx Req $ \sock -> do withSocket ctx Req $ \sock -> do
connectAndSendOrder step sock defaultOrder ep connectAndSendOrder step sock defaultOrder ep
Just ResponseOk <- decode . BL.fromStrict <$> receive sock Just ResponseOk <- decode . BL.fromStrict <$> receive sock
@ -418,7 +419,7 @@ testBrokerServerDuplicateRequest = testCaseSteps "Broker Server: duplicate reque
step "Setup" step "Setup"
(mockBroker, broState) <- mkMockBroker ["demo"] (mockBroker, broState) <- mkMockBroker ["demo"]
(ep, notifEp) <- makeEndpoints (ep, notifEp) <- makeEndpoints
bracket (startBrokerServer [mockBroker] ctx ep notifEp [] defaultServerSecurityParams) stopBrokerServer $ \_ -> do bracket (startBrokerServer [mockBroker] ctx ep notifEp [] defaultServerSecurityParams emptyLogger) stopBrokerServer $ \_ -> do
withSocket ctx Req $ \sock -> do withSocket ctx Req $ \sock -> do
connectAndSendOrder step sock defaultOrder ep connectAndSendOrder step sock defaultOrder ep
@ -445,7 +446,7 @@ testBrokerServerNotificationSocket = testCaseSteps "Broker Server: sends notific
(mockBroker, broState) <- mkMockBroker ["demo"] (mockBroker, broState) <- mkMockBroker ["demo"]
(ep, notifEp) <- makeEndpoints (ep, notifEp) <- makeEndpoints
bracket (startBrokerServer [mockBroker] ctx ep notifEp [] defaultServerSecurityParams) stopBrokerServer $ \_ -> do bracket (startBrokerServer [mockBroker] ctx ep notifEp [] defaultServerSecurityParams emptyLogger) stopBrokerServer $ \_ -> do
withSocket ctx Req $ \sock -> do withSocket ctx Req $ \sock -> do
nSocket <- socket ctx Sub nSocket <- socket ctx Sub
connect nSocket (T.unpack notifEp) connect nSocket (T.unpack notifEp)

Write Preview
Loading…
Cancel
Save