diff --git a/libatrade.cabal b/libatrade.cabal index 0342a7e..b200120 100644 --- a/libatrade.cabal +++ b/libatrade.cabal @@ -1,5 +1,5 @@ name: libatrade -version: 0.5.0.0 +version: 0.7.0.0 synopsis: ATrade infrastructure core library description: Please see README.md homepage: https://github.com/asakul/libatrade.git @@ -7,7 +7,7 @@ license: BSD3 license-file: LICENSE author: Denis Tereshkin maintainer: denis@kasan.ws -copyright: 2016 Denis Tereshkin +copyright: 2018 Denis Tereshkin category: Trading build-type: Simple -- extra-source-files: @@ -90,7 +90,7 @@ test-suite libatrade-test , monad-loops , uuid , stm - ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wincomplete-patterns + ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wincomplete-patterns -Wno-orphans default-language: Haskell2010 other-modules: ArbitraryInstances , MockBroker diff --git a/src/ATrade/Broker/Client.hs b/src/ATrade/Broker/Client.hs index ba5332b..ae856a5 100644 --- a/src/ATrade/Broker/Client.hs +++ b/src/ATrade/Broker/Client.hs @@ -64,11 +64,11 @@ brokerClientThread socketIdentity ctx ep cmd resp comp killMv secParams = finall case cspServerCertificate secParams of Just serverCert -> zapSetServerCertificate serverCert sock Nothing -> return () - + connect sock $ T.unpack ep debugM "Broker.Client" $ "Connected" isTimeout <- newIORef False - + whileM_ (andM [isNothing <$> tryReadMVar killMv, (== False) <$> readIORef isTimeout]) $ do request <- takeMVar cmd send sock [] (BL.toStrict $ encode request) diff --git a/src/ATrade/Price.hs b/src/ATrade/Price.hs index c324e5b..023eda3 100644 --- a/src/ATrade/Price.hs +++ b/src/ATrade/Price.hs @@ -17,16 +17,12 @@ import Data.Ratio import Data.Aeson import Data.Scientific -import qualified Data.Text as T import Text.Printf data Price = Price { priceQuants :: !Int64 } deriving (Eq, Ord) -giga :: Int64 -giga = 1000000000 - mega :: Int64 mega = 1000000 diff --git a/stack.yaml b/stack.yaml index f88d557..6a1a42e 100644 --- a/stack.yaml +++ b/stack.yaml @@ -15,7 +15,7 @@ # resolver: # name: custom-snapshot # location: "./custom-snapshot.yaml" -resolver: lts-11.9 +resolver: lts-12.9 # User packages to be built. # Various formats can be used as shown in the example below. diff --git a/test/ArbitraryInstances.hs b/test/ArbitraryInstances.hs index 5e5c361..8e26580 100644 --- a/test/ArbitraryInstances.hs +++ b/test/ArbitraryInstances.hs @@ -5,20 +5,17 @@ module ArbitraryInstances ( ) where -import Test.Tasty -import Test.Tasty.SmallCheck as SC import Test.Tasty.QuickCheck as QC -import Test.QuickCheck.Instances hiding (Text) +import Test.QuickCheck.Instances () import ATrade.Types import ATrade.Price as P import ATrade.Broker.Protocol -import Data.Int -import Data.Scientific import Data.Time.Clock import Data.Time.Calendar +notTooBig :: (Num a, Ord a) => a -> Bool notTooBig x = abs x < 100000000 instance Arbitrary Tick where @@ -79,6 +76,7 @@ instance Arbitrary Order where instance Arbitrary Trade where arbitrary = Trade <$> + arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> @@ -103,9 +101,9 @@ instance Arbitrary Notification where instance Arbitrary BrokerServerRequest where arbitrary = do t <- choose (1, 3) :: Gen Int - if | t == 1 -> RequestSubmitOrder <$> arbitrary <*> arbitrary - | t == 2 -> RequestCancelOrder <$> arbitrary <*> arbitrary - | t == 3 -> RequestNotifications <$> arbitrary + if | t == 1 -> RequestSubmitOrder <$> arbitrary <*> arbitrary <*> arbitrary + | t == 2 -> RequestCancelOrder <$> arbitrary <*> arbitrary <*> arbitrary + | t == 3 -> RequestNotifications <$> arbitrary <*> arbitrary instance Arbitrary BrokerServerResponse where arbitrary = do diff --git a/test/TestBrokerServer.hs b/test/TestBrokerServer.hs index 1b39724..f477553 100644 --- a/test/TestBrokerServer.hs +++ b/test/TestBrokerServer.hs @@ -5,8 +5,6 @@ module TestBrokerServer ( ) where import Test.Tasty -import Test.Tasty.SmallCheck as SC -import Test.Tasty.QuickCheck as QC import Test.Tasty.HUnit import ATrade.Types @@ -14,26 +12,19 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import ATrade.Broker.Server import ATrade.Broker.Protocol -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.Exception import System.ZMQ4 -import System.ZMQ4.ZAP import Data.Aeson import Data.Time.Clock import Data.Time.Calendar -import Data.Maybe -import qualified Data.List as L import Data.IORef import Data.UUID as U import Data.UUID.V4 as UV4 import MockBroker +unitTests :: TestTree unitTests = testGroup "Broker.Server" [testBrokerServerStartStop , testBrokerServerSubmitOrder , testBrokerServerSubmitOrderToUnknownAccount @@ -48,18 +39,21 @@ unitTests = testGroup "Broker.Server" [testBrokerServerStartStop -- Few helpers -- +makeEndpoint :: IO T.Text makeEndpoint = do uid <- toText <$> UV4.nextRandom return $ "inproc://brokerserver" `T.append` uid +connectAndSendOrder :: (Sender a) => (String -> IO ()) -> Socket a -> Order -> T.Text -> IO () connectAndSendOrder step sock order ep = do step "Connecting" connect sock (T.unpack ep) step "Sending request" - send sock [] (BL.toStrict . encode $ RequestSubmitOrder 1 order) + send sock [] (BL.toStrict . encode $ RequestSubmitOrder 1 "identity" order) threadDelay 10000 +defaultOrder :: Order defaultOrder = mkOrder { orderAccountId = "demo", orderSecurity = "FOO", @@ -80,16 +74,18 @@ makeTestTradeSink = do -- Tests -- +testBrokerServerStartStop :: TestTree testBrokerServerStartStop = testCase "Broker Server starts and stops" $ withContext (\ctx -> do ep <- toText <$> UV4.nextRandom broS <- startBrokerServer [] ctx ("inproc://brokerserver" `T.append` ep) [] defaultServerSecurityParams stopBrokerServer broS) +testBrokerServerSubmitOrder :: TestTree testBrokerServerSubmitOrder = testCaseSteps "Broker Server submits order" $ \step -> withContext (\ctx -> do step "Setup" (mockBroker, broState) <- mkMockBroker ["demo"] ep <- makeEndpoint - bracket (startBrokerServer [mockBroker] ctx ep [] defaultServerSecurityParams) stopBrokerServer (\broS -> do + bracket (startBrokerServer [mockBroker] ctx ep [] defaultServerSecurityParams) stopBrokerServer (\_ -> do withSocket ctx Req (\sock -> do connectAndSendOrder step sock defaultOrder ep @@ -106,12 +102,13 @@ testBrokerServerSubmitOrder = testCaseSteps "Broker Server submits order" $ \ste ))) +testBrokerServerSubmitOrderToUnknownAccount :: TestTree testBrokerServerSubmitOrderToUnknownAccount = testCaseSteps "Broker Server returns error if account is unknown" $ \step -> withContext (\ctx -> do step "Setup" ep <- makeEndpoint - (mockBroker, broState) <- mkMockBroker ["demo"] - bracket (startBrokerServer [mockBroker] ctx ep [] defaultServerSecurityParams) stopBrokerServer (\broS -> + (mockBroker, _) <- mkMockBroker ["demo"] + bracket (startBrokerServer [mockBroker] ctx ep [] defaultServerSecurityParams) stopBrokerServer (\_ -> withSocket ctx Req (\sock -> do connectAndSendOrder step sock (defaultOrder { orderAccountId = "foobar" }) ep @@ -124,18 +121,19 @@ testBrokerServerSubmitOrderToUnknownAccount = testCaseSteps "Broker Server retur ))) +testBrokerServerCancelOrder :: TestTree testBrokerServerCancelOrder = testCaseSteps "Broker Server: submitted order cancellation" $ \step -> withContext (\ctx -> do step "Setup" ep <- makeEndpoint (mockBroker, broState) <- mkMockBroker ["demo"] - bracket (startBrokerServer [mockBroker] ctx ep [] defaultServerSecurityParams) stopBrokerServer (\broS -> + bracket (startBrokerServer [mockBroker] ctx ep [] defaultServerSecurityParams) stopBrokerServer (\_ -> withSocket ctx Req (\sock -> do connectAndSendOrder step sock defaultOrder ep (Just (ResponseOrderSubmitted orderId)) <- decode . BL.fromStrict <$> receive sock step "Sending order cancellation request" - send sock [] (BL.toStrict . encode $ RequestCancelOrder 2 orderId) + send sock [] (BL.toStrict . encode $ RequestCancelOrder 2 "identity" orderId) threadDelay 10000 step "Checking that order is cancelled in BrokerInterface" @@ -150,18 +148,19 @@ testBrokerServerCancelOrder = testCaseSteps "Broker Server: submitted order canc Nothing -> assertFailure "Invalid response" ))) +testBrokerServerCancelUnknownOrder :: TestTree testBrokerServerCancelUnknownOrder = testCaseSteps "Broker Server: order cancellation: error if order is unknown" $ \step -> withContext (\ctx -> do step "Setup" ep <- makeEndpoint - (mockBroker, broState) <- mkMockBroker ["demo"] - bracket (startBrokerServer [mockBroker] ctx ep [] defaultServerSecurityParams) stopBrokerServer (\broS -> + (mockBroker, _) <- mkMockBroker ["demo"] + bracket (startBrokerServer [mockBroker] ctx ep [] defaultServerSecurityParams) stopBrokerServer (\_ -> withSocket ctx Req (\sock -> do connectAndSendOrder step sock defaultOrder ep receive sock step "Sending order cancellation request" - send sock [] (BL.toStrict . encode $ RequestCancelOrder 2 100) + send sock [] (BL.toStrict . encode $ RequestCancelOrder 2 "identity" 100) threadDelay 10000 step "Reading response" @@ -172,18 +171,19 @@ testBrokerServerCancelUnknownOrder = testCaseSteps "Broker Server: order cancell Nothing -> assertFailure "Invalid response" ))) +testBrokerServerCorruptedPacket :: TestTree testBrokerServerCorruptedPacket = testCaseSteps "Broker Server: corrupted packet" $ \step -> withContext (\ctx -> do step "Setup" ep <- makeEndpoint - (mockBroker, broState) <- mkMockBroker ["demo"] - bracket (startBrokerServer [mockBroker] ctx ep [] defaultServerSecurityParams) stopBrokerServer (\broS -> + (mockBroker, _) <- mkMockBroker ["demo"] + bracket (startBrokerServer [mockBroker] ctx ep [] defaultServerSecurityParams) stopBrokerServer (\_ -> withSocket ctx Req (\sock -> do step "Connecting" connect sock (T.unpack ep) step "Sending request" - send sock [] (corrupt . BL.toStrict . encode $ RequestSubmitOrder 1 defaultOrder) + send sock [] (corrupt . BL.toStrict . encode $ RequestSubmitOrder 1 "identity" defaultOrder) threadDelay 10000 step "Reading response" @@ -196,12 +196,13 @@ testBrokerServerCorruptedPacket = testCaseSteps "Broker Server: corrupted packet where corrupt = B.drop 5 +testBrokerServerGetNotifications :: TestTree testBrokerServerGetNotifications = testCaseSteps "Broker Server: notifications request" $ \step -> withContext (\ctx -> do step "Setup" ep <- makeEndpoint (mockBroker, broState) <- mkMockBroker ["demo"] - bracket (startBrokerServer [mockBroker] ctx ep [] defaultServerSecurityParams) stopBrokerServer (\broS -> + bracket (startBrokerServer [mockBroker] ctx ep [] defaultServerSecurityParams) stopBrokerServer (\_ -> withSocket ctx Req (\sock -> do -- We have to actually submit order, or else server won't know that we should -- be notified about this order @@ -221,11 +222,12 @@ testBrokerServerGetNotifications = testCaseSteps "Broker Server: notifications r tradeAccount = "demo", tradeSecurity = "FOO", tradeTimestamp = UTCTime (fromGregorian 2016 9 28) 16000, + tradeCommission = 0, tradeSignalId = SignalId "Foo" "bar" "baz" } cb (TradeNotification trade) step "Sending notifications request" - send sock [] (BL.toStrict . encode $ RequestNotifications 2) + send sock [] (BL.toStrict . encode $ RequestNotifications 2 "identity") threadDelay 10000 -- We should obtain 3 notifications: @@ -246,25 +248,26 @@ testBrokerServerGetNotifications = testCaseSteps "Broker Server: notifications r Nothing -> assertFailure "Invalid response" step "Sending second notifications request" - send sock [] (BL.toStrict . encode $ RequestNotifications 3) + send sock [] (BL.toStrict . encode $ RequestNotifications 3 "identity") threadDelay 10000 step "Reading response" - resp <- decode . BL.fromStrict <$> receive sock - case resp of + resp' <- decode . BL.fromStrict <$> receive sock + case resp' of Just (ResponseNotifications ns) -> do 0 @=? length ns Just _ -> assertFailure "Invalid response" Nothing -> assertFailure "Invalid response" ))) +testBrokerServerDuplicateRequest :: TestTree testBrokerServerDuplicateRequest = testCaseSteps "Broker Server: duplicate request" $ \step -> withContext (\ctx -> do putStrLn "epsilon" step "Setup" (mockBroker, broState) <- mkMockBroker ["demo"] ep <- makeEndpoint putStrLn "delta" - bracket (startBrokerServer [mockBroker] ctx ep [] defaultServerSecurityParams) stopBrokerServer (\broS -> do + bracket (startBrokerServer [mockBroker] ctx ep [] defaultServerSecurityParams) stopBrokerServer (\_ -> do putStrLn "gamma" withSocket ctx Req (\sock -> do putStrLn "alpha" @@ -275,7 +278,7 @@ testBrokerServerDuplicateRequest = testCaseSteps "Broker Server: duplicate reque (Just (ResponseOrderSubmitted orderId)) <- decode . BL.fromStrict <$> receive sock step "Sending duplicate request (with same sequence number)" - send sock [] (BL.toStrict . encode $ RequestSubmitOrder 1 defaultOrder) + send sock [] (BL.toStrict . encode $ RequestSubmitOrder 1 "identity" defaultOrder) threadDelay 10000 step "Checking that only one order is submitted" @@ -291,12 +294,13 @@ testBrokerServerDuplicateRequest = testCaseSteps "Broker Server: duplicate reque ))) +testBrokerServerTradeSink :: TestTree testBrokerServerTradeSink = testCaseSteps "Broker Server: sends trades to trade sink" $ \step -> withContext (\ctx -> do step "Setup" (mockBroker, broState) <- mkMockBroker ["demo"] ep <- makeEndpoint (tradeRef, sink) <- makeTestTradeSink - bracket (startBrokerServer [mockBroker] ctx ep [sink] defaultServerSecurityParams) stopBrokerServer (\broS -> do + bracket (startBrokerServer [mockBroker] ctx ep [sink] defaultServerSecurityParams) stopBrokerServer (\_ -> do withSocket ctx Req (\sock -> do step "Connecting" connectAndSendOrder step sock defaultOrder ep @@ -313,6 +317,7 @@ testBrokerServerTradeSink = testCaseSteps "Broker Server: sends trades to trade tradeAccount = "demo", tradeSecurity = "FOO", tradeTimestamp = UTCTime (fromGregorian 2016 9 28) 16000, + tradeCommission = 0, tradeSignalId = SignalId "Foo" "bar" "baz" } cb (TradeNotification trade) diff --git a/test/TestQuoteSourceClient.hs b/test/TestQuoteSourceClient.hs index 6df2936..3c6a88a 100644 --- a/test/TestQuoteSourceClient.hs +++ b/test/TestQuoteSourceClient.hs @@ -5,47 +5,45 @@ module TestQuoteSourceClient ( ) where import Test.Tasty -import Test.Tasty.SmallCheck as SC -import Test.Tasty.QuickCheck as QC import Test.Tasty.HUnit import ATrade.Types import ATrade.QuoteSource.Server import ATrade.QuoteSource.Client import Control.Monad -import Control.Monad.Loops -import Control.Concurrent.MVar import Control.Concurrent.BoundedChan import Control.Concurrent hiding (writeChan, readChan) import Control.Exception import System.ZMQ4 import Data.Time.Clock import Data.Time.Calendar -import qualified Data.ByteString.Lazy as BL import qualified Data.Text as T -import Data.Maybe import Data.UUID as U import Data.UUID.V4 as UV4 +makeEndpoint :: IO T.Text makeEndpoint = do uid <- toText <$> UV4.nextRandom return $ "inproc://server" `T.append` uid +unitTests :: TestTree unitTests = testGroup "QuoteSource.Client" [testStartStop, testTickStream] +testStartStop :: TestTree testStartStop = testCase "QuoteSource client connects and disconnects" $ withContext (\ctx -> do ep <- makeEndpoint chan <- newBoundedChan 1000 clientChan <- newBoundedChan 1000 - bracket (startQuoteSourceServer chan ctx ep) stopQuoteSourceServer (\qs -> + bracket (startQuoteSourceServer chan ctx ep Nothing) stopQuoteSourceServer (\_ -> bracket (startQuoteSourceClient clientChan [] ctx ep) stopQuoteSourceClient (const yield))) +testTickStream :: TestTree testTickStream = testCase "QuoteSource clients receives ticks" $ withContext (\ctx -> do ep <- makeEndpoint chan <- newBoundedChan 1000 clientChan <- newBoundedChan 1000 - bracket (startQuoteSourceServer chan ctx ep) stopQuoteSourceServer (\qs -> - bracket (startQuoteSourceClient clientChan ["FOOBAR"] ctx ep) stopQuoteSourceClient (\qc -> do + bracket (startQuoteSourceServer chan ctx ep Nothing) stopQuoteSourceServer (\_ -> + bracket (startQuoteSourceClient clientChan ["FOOBAR"] ctx ep) stopQuoteSourceClient (\_ -> do let tick = Tick { security = "FOOBAR", datatype = LastTradePrice, diff --git a/test/TestQuoteSourceServer.hs b/test/TestQuoteSourceServer.hs index 4fce690..507e64e 100644 --- a/test/TestQuoteSourceServer.hs +++ b/test/TestQuoteSourceServer.hs @@ -5,34 +5,30 @@ module TestQuoteSourceServer ( ) where import Test.Tasty -import Test.Tasty.SmallCheck as SC -import Test.Tasty.QuickCheck as QC import Test.Tasty.HUnit import ATrade.Types import qualified Data.ByteString.Lazy as BL import ATrade.QuoteSource.Server -import Control.Monad -import Control.Monad.Loops -import Control.Concurrent.MVar -import Control.Concurrent hiding (writeChan) import Control.Concurrent.BoundedChan import Control.Exception import System.ZMQ4 import Data.Time.Clock import Data.Time.Calendar -import Data.Maybe +unitTests :: TestTree unitTests = testGroup "QuoteSource.Server" [testStartStop, testTickStream] +testStartStop :: TestTree testStartStop = testCase "QuoteSource Server starts and stops" $ withContext (\ctx -> do chan <- newBoundedChan 1000 - qss <- startQuoteSourceServer chan ctx "inproc://quotesource-server" + qss <- startQuoteSourceServer chan ctx "inproc://quotesource-server" Nothing stopQuoteSourceServer qss) +testTickStream :: TestTree testTickStream = testCase "QuoteSource Server sends ticks" $ withContext (\ctx -> do chan <- newBoundedChan 1000 - bracket (startQuoteSourceServer chan ctx "inproc://quotesource-server") stopQuoteSourceServer (\qs -> + bracket (startQuoteSourceServer chan ctx "inproc://quotesource-server" Nothing) stopQuoteSourceServer (\_ -> withSocket ctx Sub (\s -> do connect s "inproc://quotesource-server" subscribe s "FOOBAR" diff --git a/test/TestTypes.hs b/test/TestTypes.hs index f1e3b82..3fe9f9c 100644 --- a/test/TestTypes.hs +++ b/test/TestTypes.hs @@ -6,23 +6,16 @@ module TestTypes ( ) where import Test.Tasty -import Test.Tasty.SmallCheck as SC import Test.Tasty.QuickCheck as QC -import Test.Tasty.HUnit import ATrade.Types import ATrade.Price as P -import ArbitraryInstances +import ArbitraryInstances () import Data.Aeson -import Data.Aeson.Types -import Data.Scientific -import Data.Text -import Data.Time.Calendar -import Data.Time.Clock -import Data.Tuple.Select import qualified Data.ByteString.Lazy as B +properties :: TestTree properties = testGroup "Types" [ testTickSerialization , testTickBodySerialization @@ -40,12 +33,14 @@ properties = testGroup "Types" [ , testPriceSubtraction ] +testTickSerialization :: TestTree testTickSerialization = QC.testProperty "Deserialize serialized tick" (\tick -> case (deserializeTick . serializeTick) tick of Just t -> tick == t Nothing -> False) -- Adjust arbitrary instances of ticks, because body doesn't store security name +testTickBodySerialization :: TestTree testTickBodySerialization = QC.testProperty "Deserialize serialized bunch of tick" $ QC.forAll (arbitrary >>= (\t -> return t { security = "" })) (\tick1 -> QC.forAll (arbitrary >>= (\t -> return t { security = "" })) (\tick2 -> @@ -57,55 +52,67 @@ testTickBodySerialization = QC.testProperty "Deserialize serialized bunch of tic where serialized t1 t2 = serializeTickBody t1 `B.append` serializeTickBody t2 +testSignalIdSerialization :: TestTree testSignalIdSerialization = QC.testProperty "Deserialize serialized SignalId" (\sid -> case (decode . encode $ sid :: Maybe SignalId) of Just s -> s == sid Nothing -> False) +testOrderPriceSerialization :: TestTree testOrderPriceSerialization = QC.testProperty "Deserialize serialized OrderPrice" (\v -> case (decode . encode $ v :: Maybe OrderPrice) of Just s -> s == v Nothing -> False) +testOperationSerialization :: TestTree testOperationSerialization = QC.testProperty "Deserialize serialized Operation" (\v -> case (decode . encode $ v :: Maybe Operation) of Just s -> s == v Nothing -> False) +testOrderStateSerialization :: TestTree testOrderStateSerialization = QC.testProperty "Deserialize serialized OrderState" (\v -> case (decode . encode $ v :: Maybe OrderState) of Just s -> s == v Nothing -> False) +testOrderSerialization :: TestTree testOrderSerialization = QC.testProperty "Deserialize serialized Order" (\v -> case (decode . encode $ v :: Maybe Order) of Just s -> s == v Nothing -> False) +testTradeSerialization :: TestTree testTradeSerialization = QC.testProperty "Deserialize serialized Trade" (\v -> case (decode . encode $ v :: Maybe Trade) of Just s -> s == v Nothing -> False) +testPrice1 :: TestTree testPrice1 = QC.testProperty "fromDouble . toDouble $ Price" (\p -> let newp = (P.fromDouble . P.toDouble) p in (abs (priceQuants newp - priceQuants p) < 1000)) +testPrice2 :: TestTree testPrice2 = QC.testProperty "toDouble . fromDouble $ Price" $ QC.forAll (arbitrary `suchThat` (< 1000000000)) (\d -> let newd = (P.toDouble . P.fromDouble) d in (abs (newd - d) < 0.000001)) +testPriceDecompose :: TestTree testPriceDecompose = QC.testProperty "Price decompose" (\p -> let (i, f) = decompose p in i * 1000000 + (fromInteger . fromIntegral) f == priceQuants p) +testPriceAddition :: TestTree testPriceAddition = QC.testProperty "Price addition" (\(p1, p2) -> abs (toDouble p1 + toDouble p2 - toDouble (p1 + p2)) < 0.00001) +testPriceMultiplication :: TestTree testPriceMultiplication = QC.testProperty "Price multiplication" $ QC.forAll (arbitrary `suchThat` (\(p1, p2) -> p1 < 100000 && p2 < 100000)) (\(p1, p2) -> abs (toDouble p1 + toDouble p2 - toDouble (p1 + p2)) < 0.00001) +testPriceSubtraction :: TestTree testPriceSubtraction = QC.testProperty "Price subtraction" (\(p1, p2) -> abs (toDouble p1 - toDouble p2 - toDouble (p1 - p2)) < 0.00001) diff --git a/test/TestZMQTradeSink.hs b/test/TestZMQTradeSink.hs index 1f9f107..3613a68 100644 --- a/test/TestZMQTradeSink.hs +++ b/test/TestZMQTradeSink.hs @@ -5,14 +5,11 @@ module TestZMQTradeSink ( ) where import Test.Tasty -import Test.Tasty.SmallCheck as SC -import Test.Tasty.QuickCheck as QC import Test.Tasty.HUnit import ATrade.Types import ATrade.Broker.Protocol import ATrade.Broker.TradeSinks.ZMQTradeSink -import Control.Concurrent import System.ZMQ4 import Data.Aeson import Data.Time.Calendar @@ -20,8 +17,10 @@ import Data.Time.Clock import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL +unitTests :: TestTree unitTests = testGroup "Broker.Server.TradeSinks.ZMQTradeSink" [ testZMQTradeSink ] +testZMQTradeSink :: TestTree testZMQTradeSink = testCase "Test ZMQTradeSink trade serialization" $ withContext (\ctx -> withSocket ctx Rep (\insock -> do bind insock "inproc://test-sink" @@ -43,5 +42,6 @@ testZMQTradeSink = testCase "Test ZMQTradeSink trade serialization" $ tradeAccount = "FOO", tradeSecurity = "BAR", tradeTimestamp = UTCTime (fromGregorian 1970 1 1) 0, + tradeCommission = 0, tradeSignalId = SignalId "foo" "bar" "" }