Fix price <-> double conversion

src/ATrade/Price.hs

@@ -45,7 +45,9 @@ toDouble :: Price -> Double
 toDouble p = fromIntegral (priceQuants p) / fromIntegral mega
 
 fromDouble :: Double -> Price
-fromDouble d = Price { priceQuants = truncate ((d * fromIntegral mega) + 0.5) }
+fromDouble d
+  | d >= 0 = Price { priceQuants = truncate ((d * fromIntegral mega) + 0.5) }
+  | otherwise = Price { priceQuants = truncate ((d * fromIntegral mega) - 0.5) }
 
 toScientific :: Price -> Scientific
 toScientific p = normalize $ scientific (toInteger $ priceQuants p) (-6)

test/TestQuoteSourceClient.hs

@@ -20,6 +20,7 @@ import           Data.Time.Clock
 import           Data.UUID                      as U
 import           Data.UUID.V4                   as UV4
 import           System.ZMQ4
+import           System.ZMQ4.ZAP
 
 makeEndpoint :: IO T.Text
 makeEndpoint = do
@@ -37,16 +38,16 @@ testStartStop = testCase "QuoteSource client connects and disconnects" $ withCon
   ep <- makeEndpoint
   chan <- newBoundedChan 1000
   clientChan <- newBoundedChan 1000
-  bracket (startQuoteSourceServer chan ctx ep Nothing) stopQuoteSourceServer (\_ ->
-    bracket (startQuoteSourceClient clientChan [] ctx ep) stopQuoteSourceClient (const yield)))
+  bracket (startQuoteSourceServer chan ctx ep defaultServerSecurityParams) stopQuoteSourceServer (\_ ->
+    bracket (startQuoteSourceClient clientChan [] ctx ep defaultClientSecurityParams) 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 Nothing) stopQuoteSourceServer (\_ ->
-    bracket (startQuoteSourceClient clientChan ["FOOBAR"] ctx ep) stopQuoteSourceClient (\_ -> do
+  bracket (startQuoteSourceServer chan ctx ep defaultServerSecurityParams) stopQuoteSourceServer (\_ ->
+    bracket (startQuoteSourceClient clientChan ["FOOBAR"] ctx ep defaultClientSecurityParams) stopQuoteSourceClient (\_ -> do
       let tick = Tick {
           security = "FOOBAR",
           datatype = LastTradePrice,
@@ -62,8 +63,8 @@ testBarStream = testCase "QuoteSource clients receives bars" $ withContext (\ctx
   ep <- makeEndpoint
   chan <- newBoundedChan 1000
   clientChan <- newBoundedChan 1000
-  bracket (startQuoteSourceServer chan ctx ep Nothing) stopQuoteSourceServer (\_ ->
-    bracket (startQuoteSourceClient clientChan ["FOOBAR"] ctx ep) stopQuoteSourceClient (\_ -> do
+  bracket (startQuoteSourceServer chan ctx ep defaultServerSecurityParams) stopQuoteSourceServer (\_ ->
+    bracket (startQuoteSourceClient clientChan ["FOOBAR"] ctx ep defaultClientSecurityParams) stopQuoteSourceClient (\_ -> do
       let bar = Bar {
           barSecurity = "FOOBAR",
           barTimestamp = UTCTime (fromGregorian 2016 9 27) 16000,

test/TestQuoteSourceServer.hs

@@ -15,6 +15,7 @@ import qualified Data.ByteString.Lazy           as BL
 import           Data.Time.Calendar
 import           Data.Time.Clock
 import           System.ZMQ4
+import           System.ZMQ4.ZAP
 
 unitTests :: TestTree
 unitTests = testGroup "QuoteSource.Server" [
@@ -25,13 +26,13 @@ unitTests = testGroup "QuoteSource.Server" [
 testStartStop :: TestTree
 testStartStop = testCase "QuoteSource Server starts and stops" $ withContext (\ctx -> do
   chan <- newBoundedChan 1000
-  qss <- startQuoteSourceServer chan ctx "inproc://quotesource-server" Nothing
+  qss <- startQuoteSourceServer chan ctx "inproc://quotesource-server" defaultServerSecurityParams
   stopQuoteSourceServer qss)
 
 testTickStream :: TestTree
 testTickStream = testCase "QuoteSource Server sends ticks" $ withContext (\ctx -> do
   chan <- newBoundedChan 1000
-  bracket (startQuoteSourceServer chan ctx "inproc://quotesource-server" Nothing) stopQuoteSourceServer (\_ ->
+  bracket (startQuoteSourceServer chan ctx "inproc://quotesource-server" defaultServerSecurityParams) stopQuoteSourceServer (\_ ->
     withSocket ctx Sub (\s -> do
       connect s "inproc://quotesource-server"
       subscribe s "FOOBAR"
@@ -51,7 +52,7 @@ testTickStream = testCase "QuoteSource Server sends ticks" $ withContext (\ctx -
 testBarStream :: TestTree
 testBarStream = testCase "QuoteSource Server sends bars" $ withContext (\ctx -> do
   chan <- newBoundedChan 1000
-  bracket (startQuoteSourceServer chan ctx "inproc://quotesource-server" Nothing) stopQuoteSourceServer (\_ ->
+  bracket (startQuoteSourceServer chan ctx "inproc://quotesource-server" defaultServerSecurityParams) stopQuoteSourceServer (\_ ->
     withSocket ctx Sub (\s -> do
       connect s "inproc://quotesource-server"
       subscribe s "FOOBAR"

test/TestTypes.hs

@@ -1,5 +1,7 @@
-{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances #-}
+{-# LANGUAGE FlexibleInstances    #-}
 {-# LANGUAGE MultiWayIf           #-}
+{-# LANGUAGE OverloadedStrings    #-}
+{-# LANGUAGE TypeSynonymInstances #-}
 
 module TestTypes (
   properties
@@ -8,8 +10,8 @@ module TestTypes (
 import           Test.Tasty
 import           Test.Tasty.QuickCheck as QC
 
-import ATrade.Types
 import           ATrade.Price          as P
+import           ATrade.Types
 
 import           ArbitraryInstances    ()
 import           Data.Aeson
@@ -92,9 +94,9 @@ testTradeSerialization = QC.testProperty "Deserialize serialized Trade"
     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))
+testPrice1 = QC.testProperty "fromDouble . toDouble $ Price" $
+  QC.forAll (arbitrary `suchThat` (\x -> abs x < 100000000)) (\p -> let newp = (P.fromDouble . P.toDouble) p in
+    (priceQuants newp == priceQuants p))
 
 testPrice2 :: TestTree
 testPrice2 = QC.testProperty "toDouble . fromDouble $ Price" $