Tick serialization/deserialization test

app/Main.hs

@@ -1,6 +1,4 @@
 module Main where
 
-import Lib
-
 main :: IO ()
-main = someFunc
+main = undefined

libatrade.cabal

@@ -15,8 +15,14 @@ cabal-version:       >=1.10
 
 library
   hs-source-dirs:      src
-  exposed-modules:     Lib
+  exposed-modules:     ATrade.Types
   build-depends:       base >= 4.7 && < 5
+                     , Decimal
+                     , time
+                     , datetime
+                     , bytestring
+                     , text
+                     , binary
   default-language:    Haskell2010
 
 executable libatrade-exe
@@ -25,6 +31,7 @@ executable libatrade-exe
   ghc-options:         -threaded -rtsopts -with-rtsopts=-N
   build-depends:       base
                      , libatrade
+                     , pretty-hex
   default-language:    Haskell2010
 
 test-suite libatrade-test
@@ -33,6 +40,18 @@ test-suite libatrade-test
   main-is:             Spec.hs
   build-depends:       base
                      , libatrade
+                     , tasty
+                     , tasty-hunit
+                     , tasty-golden
+                     , tasty-smallcheck
+                     , tasty-quickcheck
+                     , tasty-hspec
+                     , quickcheck-text
+                     , quickcheck-instances
+                     , Decimal
+                     , scientific
+                     , tuple
+                     , time
   ghc-options:         -threaded -rtsopts -with-rtsopts=-N
   default-language:    Haskell2010
 

src/ATrade/Types.hs

@@ -0,0 +1,123 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module ATrade.Types (
+  Tick(..),
+  DataType(..),
+  serializeTick,
+  deserializeTick
+) where
+
+import Data.Decimal
+import Data.Time.Clock
+import Data.DateTime
+import Data.ByteString.Lazy as B
+import Data.Text as T
+import Data.Text.Encoding as E
+import Data.List as L
+import Data.Binary.Builder
+import Data.Binary.Get
+import Data.Int
+import Data.Word
+import Data.Ratio
+import Control.Monad
+
+data DataType = Unknown
+  | Price
+  | OpenInterest
+  | BestBid
+  | BestOffer
+  | Depth
+  | TheoryPrice
+  | Volatility
+  | TotalSupply
+  | TotalDemand
+  deriving (Show, Eq, Ord)
+
+instance Enum DataType where
+  fromEnum x
+    | x == Price = 1
+    | x == OpenInterest = 3
+    | x == BestBid = 4
+    | x == BestOffer = 5
+    | x == Depth = 6
+    | x == TheoryPrice = 7
+    | x == Volatility = 8
+    | x == TotalSupply = 9
+    | x == TotalDemand = 10
+    | x == Unknown = -1
+    | otherwise = -1
+
+  toEnum x
+    | x == 1 = Price
+    | x == 3 = OpenInterest
+    | x == 4 = BestBid
+    | x == 5 = BestOffer
+    | x == 6 = Depth
+    | x == 7 = TheoryPrice
+    | x == 8 = Volatility
+    | x == 9 = TotalSupply
+    | x == 10 = TotalDemand
+    | otherwise = Unknown
+
+data Tick = Tick {
+  security :: T.Text,
+  datatype :: DataType,
+  timestamp :: UTCTime,
+  value :: Decimal,
+  volume :: Integer
+} deriving (Show, Eq)
+
+serializeTick :: Tick -> [ByteString]
+serializeTick tick = header : [rawdata]
+  where
+    header = B.fromStrict . E.encodeUtf8 $ security tick
+    rawdata = toLazyByteString $ mconcat [
+      putWord32le 1,
+      putWord64le $ fromIntegral . toSeconds' . timestamp $ tick,
+      putWord32le $ fromIntegral . floor . (* 1000000) . fracSeconds . timestamp $ tick,
+      putWord32le $ fromIntegral . fromEnum . datatype $ tick,
+      putWord64le $ truncate . value $ tick,
+      putWord32le $ truncate . (* 1000000000) . fractionalPart $ value tick,
+      putWord32le $ fromIntegral $ volume tick ]
+    floorPart :: (RealFrac a) => a -> a
+    floorPart x = x - fromIntegral (floor x)
+    fractionalPart :: (RealFrac a) => a -> a
+    fractionalPart x = x - fromIntegral (truncate x)
+    toSeconds' t = floor $ diffUTCTime t epoch
+    fracSeconds t = floorPart $ diffUTCTime t epoch
+    epoch = fromGregorian 1970 1 1 0 0 0
+
+
+deserializeTick :: [ByteString] -> Maybe Tick
+deserializeTick (header:rawData:_) = case runGetOrFail parseTick rawData of
+  Left (_, _, _) -> Nothing
+  Right (_, _, tick) -> Just $ tick { security = E.decodeUtf8 . B.toStrict $ header }
+  where
+    parseTick :: Get Tick
+    parseTick = do
+      packetType <- fromEnum <$> getWord32le
+      when (packetType /= 1) $ fail "Expected packettype == 1"
+      tsec <- getWord64le
+      tusec <- getWord32le
+      dt <- toEnum . fromEnum <$> getWord32le
+      intpart <- (fromIntegral <$> getWord64le) :: Get Int64
+      nanopart <- (fromIntegral <$> getWord32le) :: Get Int32
+      volume <- fromIntegral <$> (fromIntegral <$> getWord32le :: Get Int32)
+      return Tick { security = "",
+        datatype = dt,
+        timestamp = makeTimestamp tsec tusec,
+        value = makeValue intpart nanopart,
+        volume = volume }
+
+    makeTimestamp :: Word64 -> Word32 -> UTCTime
+    makeTimestamp sec usec = addUTCTime (fromRational $ toInteger usec % 1000000) (fromSeconds . toInteger $ sec)
+
+    makeValue :: Int64 -> Int32 -> Decimal
+    makeValue intpart nanopart = case eitherFromRational r of
+      Right v -> v + convertedIntPart
+      Left _ -> convertedIntPart
+      where
+        convertedIntPart = realFracToDecimal 10 (fromIntegral intpart) 
+        r = toInteger nanopart % 1000000000
+
+deserializeTick _ = Nothing

src/Lib.hs

@@ -1,6 +0,0 @@
-module Lib
-    ( someFunc
-    ) where
-
-someFunc :: IO ()
-someFunc = putStrLn "someFunc"

stack.yaml

@@ -39,7 +39,7 @@ packages:
 - '.'
 # Dependency packages to be pulled from upstream that are not in the resolver
 # (e.g., acme-missiles-0.3)
-extra-deps: []
+extra-deps: [ "datetime-0.3.1", "hexdump-0.1"]
 
 # Override default flag values for local packages and extra-deps
 flags: {}
@@ -63,4 +63,4 @@ extra-package-dbs: []
 # extra-lib-dirs: [/path/to/dir]
 #
 # Allow a newer minor version of GHC than the snapshot specifies
-# compiler-check: newer-minor
+# compiler-check: newer-minor

test/Spec.hs

@@ -1,2 +1,11 @@
+
+import TestTypes
+
+import Test.Tasty
+
 main :: IO ()
-main = putStrLn "Test suite not yet implemented"
+main = defaultMain tests
+
+tests :: TestTree
+tests = testGroup "Tests" [TestTypes.properties]
+

test/TestTypes.hs

@@ -0,0 +1,50 @@
+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
+
+module TestTypes (
+  properties
+) where
+
+import Test.Tasty
+import Test.Tasty.SmallCheck as SC
+import Test.Tasty.QuickCheck as QC
+import Test.Tasty.HUnit
+
+import ATrade.Types
+import Data.Decimal
+import Data.Time.Clock
+import Data.Time.Calendar
+import Data.Scientific
+import Data.Tuple.Select
+
+import Test.QuickCheck.Instances hiding (Text)
+
+instance Arbitrary Tick where
+  arbitrary = Tick <$>
+    arbitrary <*>
+    arbitrary <*>
+    arbitraryTimestamp <*>
+    (roundTo 9 <$> (arbitrary `suchThat` (\x -> abs x < 1000000000000))) <*>
+    arbitrary
+    where
+      arbitraryTimestamp = do
+        y <- choose (1970, 2050)
+        m <- choose (1, 12)
+        d <- choose (1, 31)
+
+        sec <- secondsToDiffTime <$> choose (0, 86399)
+
+        return $ UTCTime (fromGregorian y m d) sec
+
+instance Arbitrary DataType where
+  arbitrary = toEnum <$> choose (1, 10)
+
+instance Arbitrary Decimal where
+  arbitrary = realFracToDecimal 10 <$> (arbitrary :: Gen Scientific)
+
+properties = testGroup "Types" [ testTickSerialization ]
+
+testTickSerialization = QC.testProperty "Deserialize serialized tick"
+  (\tick -> case (deserializeTick . serializeTick) tick of
+    Just t -> tick == t
+    Nothing -> False)
+