Updated to lts-12.9

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

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)

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
 

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.

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

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)
 

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,

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"

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)
 

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" "" }