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

BrokerServer: create notification socket

master
Denis Tereshkin 4 years ago
parent
57d6e4fc2b
commit
2408c49dc8
3 changed files with 95 additions and 82 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. 20
      src/ATrade/Broker/Server.hs
  2. 51
      test/TestBrokerClient.hs
  3. 50
      test/TestBrokerServer.hs

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

@ -41,6 +41,7 @@ data FullOrderId = FullOrderId ClientIdentity OrderId
data BrokerServerState = BrokerServerState { data BrokerServerState = BrokerServerState {
bsSocket :: Socket Router, bsSocket :: Socket Router,
bsNotificationsSocket :: Socket Pub,
orderToBroker :: M.Map FullOrderId BrokerBackend, orderToBroker :: M.Map FullOrderId BrokerBackend,
orderMap :: BM.Bimap FullOrderId OrderId, orderMap :: BM.Bimap FullOrderId OrderId,
lastPacket :: M.Map PeerId (RequestSqnum, BrokerServerResponse), lastPacket :: M.Map PeerId (RequestSqnum, BrokerServerResponse),
@ -57,25 +58,33 @@ data BrokerServerHandle = BrokerServerHandle ThreadId ThreadId (MVar ()) (MVar (
type TradeSink = Trade -> IO () type TradeSink = Trade -> IO ()
startBrokerServer :: [BrokerBackend] -> Context -> T.Text -> [TradeSink] -> ServerSecurityParams -> IO BrokerServerHandle startBrokerServer :: [BrokerBackend] -> Context -> T.Text -> T.Text -> [TradeSink] -> ServerSecurityParams -> IO BrokerServerHandle
startBrokerServer brokers c ep tradeSinks params = do startBrokerServer brokers c ep notificationsEp tradeSinks params = do
sock <- socket c Router sock <- socket c Router
notificationsSock <- socket c Pub
setLinger (restrict 0) sock setLinger (restrict 0) sock
setLinger (restrict 0) notificationsSock
case sspDomain params of case sspDomain params of
Just domain -> setZapDomain (restrict $ E.encodeUtf8 domain) sock Just domain -> do
setZapDomain (restrict $ E.encodeUtf8 domain) sock
setZapDomain (restrict $ E.encodeUtf8 domain) notificationsSock
Nothing -> return () Nothing -> return ()
case sspCertificate params of case sspCertificate params of
Just cert -> do Just cert -> do
setCurveServer True sock setCurveServer True sock
zapApplyCertificate cert sock zapApplyCertificate cert sock
setCurveServer True notificationsSock
zapApplyCertificate cert notificationsSock
Nothing -> return () Nothing -> return ()
bind sock (T.unpack ep) bind sock (T.unpack ep)
bind notificationsSock (T.unpack notificationsEp)
tid <- myThreadId tid <- myThreadId
compMv <- newEmptyMVar compMv <- newEmptyMVar
killMv <- newEmptyMVar killMv <- newEmptyMVar
tsChan <- newBoundedChan 100 tsChan <- newBoundedChan 100
state <- newIORef BrokerServerState { state <- newIORef BrokerServerState {
bsSocket = sock, bsSocket = sock,
bsNotificationsSocket = notificationsSock,
orderMap = BM.empty, orderMap = BM.empty,
orderToBroker = M.empty, orderToBroker = M.empty,
lastPacket = M.empty, lastPacket = M.empty,
@ -111,10 +120,13 @@ notificationCallback state n = do
Nothing -> warningM "Broker.Server" "Notification: unknown order" Nothing -> warningM "Broker.Server" "Notification: unknown order"
where where
addNotification clientIdentity n = atomicMapIORef state (\s -> addNotification clientIdentity n = do
atomicMapIORef state (\s ->
case M.lookup clientIdentity . pendingNotifications $ s of case M.lookup clientIdentity . pendingNotifications $ s of
Just ns -> s { pendingNotifications = M.insert clientIdentity (n : ns) (pendingNotifications s)} Just ns -> s { pendingNotifications = M.insert clientIdentity (n : ns) (pendingNotifications s)}
Nothing -> s { pendingNotifications = M.insert clientIdentity [n] (pendingNotifications s)}) Nothing -> s { pendingNotifications = M.insert clientIdentity [n] (pendingNotifications s)})
sock <- bsNotificationsSocket <$> readIORef state
sendMulti sock (E.encodeUtf8 clientIdentity :| [BL.toStrict $ encode n])
tradeSinkHandler :: Context -> IORef BrokerServerState -> [TradeSink] -> IO () tradeSinkHandler :: Context -> IORef BrokerServerState -> [TradeSink] -> IO ()
tradeSinkHandler c state tradeSinks = unless (null tradeSinks) $ tradeSinkHandler c state tradeSinks = unless (null tradeSinks) $

51
test/TestBrokerClient.hs
Unescape View File

@ -6,35 +6,36 @@ module TestBrokerClient (
) where ) where
import Test.Tasty import Test.Tasty
import Test.Tasty.SmallCheck as SC
import Test.Tasty.QuickCheck as QC
import Test.Tasty.HUnit import Test.Tasty.HUnit
import Test.Tasty.QuickCheck as QC
import Test.Tasty.SmallCheck as SC
import ATrade.Types
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import ATrade.Broker.Client import ATrade.Broker.Client
import ATrade.Broker.Server hiding (submitOrder, cancelOrder)
import ATrade.Broker.Protocol import ATrade.Broker.Protocol
import ATrade.Broker.Server hiding (cancelOrder,
submitOrder)
import ATrade.Types
import ATrade.Util import ATrade.Util
import qualified Data.Text as T
import Control.Monad
import Control.Monad.Loops
import Control.Concurrent.MVar
import Control.Concurrent.BoundedChan
import Control.Concurrent hiding (writeChan) import Control.Concurrent hiding (writeChan)
import Control.Concurrent.BoundedChan
import Control.Concurrent.MVar
import Control.Exception import Control.Exception
import System.ZMQ4 import Control.Monad
import System.ZMQ4.ZAP import Control.Monad.Loops
import Data.Aeson import Data.Aeson
import Data.Time.Clock import qualified Data.ByteString as B
import Data.Time.Calendar import qualified Data.ByteString.Lazy as BL
import Data.Maybe
import qualified Data.List as L
import Data.IORef import Data.IORef
import qualified Data.List as L
import Data.Maybe
import qualified Data.Text as T
import Data.Time.Calendar
import Data.Time.Clock
import Data.UUID as U import Data.UUID as U
import Data.UUID.V4 as UV4 import Data.UUID.V4 as UV4
import MockBroker import MockBroker
import System.ZMQ4
import System.ZMQ4.ZAP
unitTests = testGroup "Broker.Client" [ unitTests = testGroup "Broker.Client" [
testBrokerClientStartStop testBrokerClientStartStop
@ -42,9 +43,9 @@ unitTests = testGroup "Broker.Client" [
, testBrokerClientGetNotifications , testBrokerClientGetNotifications
] ]
makeEndpoint = do makeEndpoints = do
uid <- toText <$> UV4.nextRandom uid <- toText <$> UV4.nextRandom
return $ "inproc://brokerserver" `T.append` uid return ("inproc://brokerserver-" `T.append` uid, "inproc://brokerserver-notifications-" `T.append` uid)
defaultOrder = mkOrder { defaultOrder = mkOrder {
orderAccountId = "demo", orderAccountId = "demo",
@ -55,9 +56,9 @@ defaultOrder = mkOrder {
} }
testBrokerClientStartStop = testCase "Broker client: submit order" $ withContext (\ctx -> do testBrokerClientStartStop = testCase "Broker client: submit order" $ withContext (\ctx -> do
ep <- makeEndpoint (ep, notifEp) <- makeEndpoints
(mockBroker, broState) <- mkMockBroker ["demo"] (mockBroker, broState) <- mkMockBroker ["demo"]
bracket (startBrokerServer [mockBroker] ctx ep [] defaultServerSecurityParams) stopBrokerServer (\broS -> bracket (startBrokerServer [mockBroker] ctx ep notifEp [] defaultServerSecurityParams) stopBrokerServer (\broS ->
bracket (startBrokerClient "foo" ctx ep defaultClientSecurityParams) stopBrokerClient (\broC -> do bracket (startBrokerClient "foo" ctx ep defaultClientSecurityParams) stopBrokerClient (\broC -> do
oid <- submitOrder broC defaultOrder oid <- submitOrder broC defaultOrder
case oid of case oid of
@ -65,9 +66,9 @@ testBrokerClientStartStop = testCase "Broker client: submit order" $ withContext
Right _ -> return ()))) Right _ -> return ())))
testBrokerClientCancelOrder = testCase "Broker client: submit and cancel order" $ withContext (\ctx -> do testBrokerClientCancelOrder = testCase "Broker client: submit and cancel order" $ withContext (\ctx -> do
ep <- makeEndpoint (ep, notifEp) <- makeEndpoints
(mockBroker, broState) <- mkMockBroker ["demo"] (mockBroker, broState) <- mkMockBroker ["demo"]
bracket (startBrokerServer [mockBroker] ctx ep [] defaultServerSecurityParams) stopBrokerServer (\broS -> bracket (startBrokerServer [mockBroker] ctx ep notifEp [] defaultServerSecurityParams) stopBrokerServer (\broS ->
bracket (startBrokerClient "foo" ctx ep defaultClientSecurityParams) stopBrokerClient (\broC -> do bracket (startBrokerClient "foo" ctx ep defaultClientSecurityParams) stopBrokerClient (\broC -> do
maybeOid <- submitOrder broC defaultOrder maybeOid <- submitOrder broC defaultOrder
case maybeOid of case maybeOid of
@ -80,9 +81,9 @@ testBrokerClientCancelOrder = testCase "Broker client: submit and cancel order"
))) )))
testBrokerClientGetNotifications = testCase "Broker client: get notifications" $ withContext (\ctx -> do testBrokerClientGetNotifications = testCase "Broker client: get notifications" $ withContext (\ctx -> do
ep <- makeEndpoint (ep, notifEp) <- makeEndpoints
(mockBroker, broState) <- mkMockBroker ["demo"] (mockBroker, broState) <- mkMockBroker ["demo"]
bracket (startBrokerServer [mockBroker] ctx ep [] defaultServerSecurityParams) stopBrokerServer (\broS -> bracket (startBrokerServer [mockBroker] ctx ep notifEp [] defaultServerSecurityParams) stopBrokerServer (\broS ->
bracket (startBrokerClient "foo" ctx ep defaultClientSecurityParams) stopBrokerClient (\broC -> do bracket (startBrokerClient "foo" ctx ep defaultClientSecurityParams) stopBrokerClient (\broC -> do
maybeOid <- submitOrder broC defaultOrder maybeOid <- submitOrder broC defaultOrder
case maybeOid of case maybeOid of

50
test/TestBrokerServer.hs
Unescape View File

@ -44,10 +44,10 @@ unitTests = testGroup "Broker.Server" [testBrokerServerStartStop
-- Few helpers -- Few helpers
-- --
makeEndpoint :: IO T.Text makeEndpoints :: IO (T.Text, T.Text)
makeEndpoint = do makeEndpoints = do
uid <- toText <$> UV4.nextRandom uid <- toText <$> UV4.nextRandom
return $ "inproc://brokerserver" `T.append` uid return ("inproc://brokerserver-" `T.append` uid, "inproc://brokerserver-notifications-" `T.append` uid)
connectAndSendOrder :: (Sender a) => (String -> IO ()) -> Socket a -> Order -> T.Text -> IO () connectAndSendOrder :: (Sender a) => (String -> IO ()) -> Socket a -> Order -> T.Text -> IO ()
connectAndSendOrder step sock order ep = do connectAndSendOrder step sock order ep = do
@ -91,16 +91,16 @@ 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 <- toText <$> UV4.nextRandom (ep, notifEp) <- makeEndpoints
broS <- startBrokerServer [] ctx ("inproc://brokerserver" `T.append` ep) [] defaultServerSecurityParams broS <- startBrokerServer [] ctx ep notifEp [] defaultServerSecurityParams
stopBrokerServer broS) stopBrokerServer broS)
testBrokerServerSubmitOrder :: TestTree testBrokerServerSubmitOrder :: TestTree
testBrokerServerSubmitOrder = testCaseSteps "Broker Server submits order" $ \step -> withContext $ \ctx -> do testBrokerServerSubmitOrder = testCaseSteps "Broker Server submits order" $ \step -> withContext $ \ctx -> do
step "Setup" step "Setup"
(mockBroker, broState) <- mkMockBroker ["demo"] (mockBroker, broState) <- mkMockBroker ["demo"]
ep <- makeEndpoint (ep, notifEp) <- makeEndpoints
bracket (startBrokerServer [mockBroker] ctx ep [] defaultServerSecurityParams) stopBrokerServer $ \_ -> do bracket (startBrokerServer [mockBroker] ctx ep notifEp [] defaultServerSecurityParams) stopBrokerServer $ \_ -> do
withSocket ctx Req $ \sock -> do withSocket ctx Req $ \sock -> do
connectAndSendOrder step sock defaultOrder ep connectAndSendOrder step sock defaultOrder ep
@ -119,10 +119,10 @@ testBrokerServerSubmitOrderDifferentIdentities :: TestTree
testBrokerServerSubmitOrderDifferentIdentities = testCaseSteps "Broker Server submits order: different identities" $ \step -> withContext $ \ctx -> do testBrokerServerSubmitOrderDifferentIdentities = testCaseSteps "Broker Server submits order: different identities" $ \step -> withContext $ \ctx -> do
step "Setup" step "Setup"
(mockBroker, broState) <- mkMockBroker ["demo"] (mockBroker, broState) <- mkMockBroker ["demo"]
ep <- makeEndpoint (ep, notifEp) <- makeEndpoints
let orderId1 = 42 let orderId1 = 42
let orderId2 = 76 let orderId2 = 76
bracket (startBrokerServer [mockBroker] ctx ep [] defaultServerSecurityParams) stopBrokerServer $ \_ -> do bracket (startBrokerServer [mockBroker] ctx ep notifEp [] defaultServerSecurityParams) 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
@ -150,9 +150,9 @@ testBrokerServerSubmitOrderToUnknownAccount :: TestTree
testBrokerServerSubmitOrderToUnknownAccount = testCaseSteps "Broker Server returns error if account is unknown" $ testBrokerServerSubmitOrderToUnknownAccount = testCaseSteps "Broker Server returns error if account is unknown" $
\step -> withContext (\ctx -> do \step -> withContext (\ctx -> do
step "Setup" step "Setup"
ep <- makeEndpoint (ep, notifEp) <- makeEndpoints
(mockBroker, _) <- mkMockBroker ["demo"] (mockBroker, _) <- mkMockBroker ["demo"]
bracket (startBrokerServer [mockBroker] ctx ep [] defaultServerSecurityParams) stopBrokerServer (\_ -> bracket (startBrokerServer [mockBroker] ctx ep notifEp [] defaultServerSecurityParams) 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
@ -169,9 +169,9 @@ testBrokerServerCancelOrder :: TestTree
testBrokerServerCancelOrder = testCaseSteps "Broker Server: submitted order cancellation" $ testBrokerServerCancelOrder = testCaseSteps "Broker Server: submitted order cancellation" $
\step -> withContext $ \ctx -> do \step -> withContext $ \ctx -> do
step "Setup" step "Setup"
ep <- makeEndpoint (ep, notifEp) <- makeEndpoints
(mockBroker, broState) <- mkMockBroker ["demo"] (mockBroker, broState) <- mkMockBroker ["demo"]
bracket (startBrokerServer [mockBroker] ctx ep [] defaultServerSecurityParams) stopBrokerServer $ \_ -> bracket (startBrokerServer [mockBroker] ctx ep notifEp [] defaultServerSecurityParams) stopBrokerServer $ \_ ->
withSocket ctx Req $ \sock -> do withSocket ctx Req $ \sock -> do
connectAndSendOrder step sock defaultOrder ep connectAndSendOrder step sock defaultOrder ep
(Just (ResponseOrderSubmitted localOrderId)) <- decode . BL.fromStrict <$> receive sock (Just (ResponseOrderSubmitted localOrderId)) <- decode . BL.fromStrict <$> receive sock
@ -196,9 +196,9 @@ testBrokerServerCancelUnknownOrder :: TestTree
testBrokerServerCancelUnknownOrder = testCaseSteps "Broker Server: order cancellation: error if order is unknown" $ testBrokerServerCancelUnknownOrder = testCaseSteps "Broker Server: order cancellation: error if order is unknown" $
\step -> withContext (\ctx -> do \step -> withContext (\ctx -> do
step "Setup" step "Setup"
ep <- makeEndpoint (ep, notifEp) <- makeEndpoints
(mockBroker, _) <- mkMockBroker ["demo"] (mockBroker, _) <- mkMockBroker ["demo"]
bracket (startBrokerServer [mockBroker] ctx ep [] defaultServerSecurityParams) stopBrokerServer (\_ -> bracket (startBrokerServer [mockBroker] ctx ep notifEp [] defaultServerSecurityParams) 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
@ -219,9 +219,9 @@ testBrokerServerCorruptedPacket :: TestTree
testBrokerServerCorruptedPacket = testCaseSteps "Broker Server: corrupted packet" $ testBrokerServerCorruptedPacket = testCaseSteps "Broker Server: corrupted packet" $
\step -> withContext (\ctx -> do \step -> withContext (\ctx -> do
step "Setup" step "Setup"
ep <- makeEndpoint (ep, notifEp) <- makeEndpoints
(mockBroker, _) <- mkMockBroker ["demo"] (mockBroker, _) <- mkMockBroker ["demo"]
bracket (startBrokerServer [mockBroker] ctx ep [] defaultServerSecurityParams) stopBrokerServer (\_ -> bracket (startBrokerServer [mockBroker] ctx ep notifEp [] defaultServerSecurityParams) 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)
@ -244,9 +244,9 @@ testBrokerServerGetNotifications :: TestTree
testBrokerServerGetNotifications = testCaseSteps "Broker Server: notifications request" $ testBrokerServerGetNotifications = testCaseSteps "Broker Server: notifications request" $
\step -> withContext $ \ctx -> do \step -> withContext $ \ctx -> do
step "Setup" step "Setup"
ep <- makeEndpoint (ep, notifEp) <- makeEndpoints
(mockBroker, broState) <- mkMockBroker ["demo"] (mockBroker, broState) <- mkMockBroker ["demo"]
bracket (startBrokerServer [mockBroker] ctx ep [] defaultServerSecurityParams) stopBrokerServer $ \_ -> bracket (startBrokerServer [mockBroker] ctx ep notifEp [] defaultServerSecurityParams) 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
@ -304,9 +304,9 @@ testBrokerServerGetNotificationsFromSameSqnum :: TestTree
testBrokerServerGetNotificationsFromSameSqnum = testCaseSteps "Broker Server: notifications request, twice from same sqnum" $ testBrokerServerGetNotificationsFromSameSqnum = testCaseSteps "Broker Server: notifications request, twice from same sqnum" $
\step -> withContext $ \ctx -> do \step -> withContext $ \ctx -> do
step "Setup" step "Setup"
ep <- makeEndpoint (ep, notifEp) <- makeEndpoints
(mockBroker, broState) <- mkMockBroker ["demo"] (mockBroker, broState) <- mkMockBroker ["demo"]
bracket (startBrokerServer [mockBroker] ctx ep [] defaultServerSecurityParams) stopBrokerServer $ \_ -> bracket (startBrokerServer [mockBroker] ctx ep notifEp [] defaultServerSecurityParams) stopBrokerServer $ \_ ->
withSocket ctx Req $ \sock -> do withSocket ctx Req $ \sock -> do
connectAndSendOrder step sock defaultOrder ep connectAndSendOrder step sock defaultOrder ep
(Just (ResponseOrderSubmitted localOrderId)) <- decode . BL.fromStrict <$> receive sock (Just (ResponseOrderSubmitted localOrderId)) <- decode . BL.fromStrict <$> receive sock
@ -363,9 +363,9 @@ testBrokerServerGetNotificationsRemovesEarlierNotifications :: TestTree
testBrokerServerGetNotificationsRemovesEarlierNotifications = testCaseSteps "Broker Server: notifications request removes earlier notifications" $ testBrokerServerGetNotificationsRemovesEarlierNotifications = testCaseSteps "Broker Server: notifications request removes earlier notifications" $
\step -> withContext $ \ctx -> do \step -> withContext $ \ctx -> do
step "Setup" step "Setup"
ep <- makeEndpoint (ep, notifEp) <- makeEndpoints
(mockBroker, broState) <- mkMockBroker ["demo"] (mockBroker, broState) <- mkMockBroker ["demo"]
bracket (startBrokerServer [mockBroker] ctx ep [] defaultServerSecurityParams) stopBrokerServer $ \_ -> bracket (startBrokerServer [mockBroker] ctx ep notifEp [] defaultServerSecurityParams) stopBrokerServer $ \_ ->
withSocket ctx Req $ \sock -> do withSocket ctx Req $ \sock -> do
connectAndSendOrder step sock defaultOrder ep connectAndSendOrder step sock defaultOrder ep
(Just (ResponseOrderSubmitted localOrderId)) <- decode . BL.fromStrict <$> receive sock (Just (ResponseOrderSubmitted localOrderId)) <- decode . BL.fromStrict <$> receive sock
@ -418,8 +418,8 @@ testBrokerServerDuplicateRequest :: TestTree
testBrokerServerDuplicateRequest = testCaseSteps "Broker Server: duplicate request" $ \step -> withContext $ \ctx -> do testBrokerServerDuplicateRequest = testCaseSteps "Broker Server: duplicate request" $ \step -> withContext $ \ctx -> do
step "Setup" step "Setup"
(mockBroker, broState) <- mkMockBroker ["demo"] (mockBroker, broState) <- mkMockBroker ["demo"]
ep <- makeEndpoint (ep, notifEp) <- makeEndpoints
bracket (startBrokerServer [mockBroker] ctx ep [] defaultServerSecurityParams) stopBrokerServer $ \_ -> do bracket (startBrokerServer [mockBroker] ctx ep notifEp [] defaultServerSecurityParams) stopBrokerServer $ \_ -> do
withSocket ctx Req $ \sock -> do withSocket ctx Req $ \sock -> do
connectAndSendOrder step sock defaultOrder ep connectAndSendOrder step sock defaultOrder ep

Write Preview
Loading…
Cancel
Save