From 249f8021319bd29a92bc0ef89beffc2c12c11047 Mon Sep 17 00:00:00 2001 From: Denis Tereshkin Date: Tue, 27 Sep 2016 13:04:36 +0700 Subject: [PATCH] Tick serialization/deserialization test --- app/Main.hs | 4 +- libatrade.cabal | 21 +++++++- src/ATrade/Types.hs | 123 ++++++++++++++++++++++++++++++++++++++++++++ src/Lib.hs | 6 --- stack.yaml | 4 +- test/Spec.hs | 11 +++- test/TestTypes.hs | 50 ++++++++++++++++++ 7 files changed, 206 insertions(+), 13 deletions(-) create mode 100644 src/ATrade/Types.hs create mode 100644 test/TestTypes.hs diff --git a/app/Main.hs b/app/Main.hs index de1c1ab..c2e4af9 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,6 +1,4 @@ module Main where -import Lib - main :: IO () -main = someFunc +main = undefined diff --git a/libatrade.cabal b/libatrade.cabal index 29331c4..845932a 100644 --- a/libatrade.cabal +++ b/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 diff --git a/src/ATrade/Types.hs b/src/ATrade/Types.hs new file mode 100644 index 0000000..7ab325c --- /dev/null +++ b/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 diff --git a/src/Lib.hs b/src/Lib.hs index d36ff27..e69de29 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -1,6 +0,0 @@ -module Lib - ( someFunc - ) where - -someFunc :: IO () -someFunc = putStrLn "someFunc" diff --git a/stack.yaml b/stack.yaml index e0d8208..5db2651 100644 --- a/stack.yaml +++ b/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 \ No newline at end of file +# compiler-check: newer-minor diff --git a/test/Spec.hs b/test/Spec.hs index cd4753f..dad28cc 100644 --- a/test/Spec.hs +++ b/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] + diff --git a/test/TestTypes.hs b/test/TestTypes.hs new file mode 100644 index 0000000..4bf87fd --- /dev/null +++ b/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) +