diff --git a/pact.cabal b/pact.cabal index 5f71df4d1..e7091d4ff 100644 --- a/pact.cabal +++ b/pact.cabal @@ -376,6 +376,7 @@ test-suite hspec , hspec , hspec-core , pact + , pact-time , unordered-containers other-modules: @@ -384,6 +385,7 @@ test-suite hspec RoundTripSpec PrincipalSpec SizeOfSpec + Test.Pact.Types.Codec if !impl(ghcjs) other-modules: diff --git a/src/Pact/PersistPactDb.hs b/src/Pact/PersistPactDb.hs index f5498467b..9d80314b4 100644 --- a/src/Pact/PersistPactDb.hs +++ b/src/Pact/PersistPactDb.hs @@ -72,7 +72,7 @@ initDbEnv loggers funrec p = DbEnv { _mode = Nothing } -data UserTableInfo = UserTableInfo +newtype UserTableInfo = UserTableInfo { utModule :: ModuleName } deriving (Eq,Show,Generic,Typeable) diff --git a/src/Pact/Types/Advice.hs b/src/Pact/Types/Advice.hs index e4e3486f7..4fb9fe6d8 100644 --- a/src/Pact/Types/Advice.hs +++ b/src/Pact/Types/Advice.hs @@ -3,7 +3,6 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TemplateHaskell #-} -- | -- Module : Pact.Types.Advice diff --git a/src/Pact/Types/Codec.hs b/src/Pact/Types/Codec.hs index 12abae31c..9859c0029 100644 --- a/src/Pact/Types/Codec.hs +++ b/src/Pact/Types/Codec.hs @@ -1,14 +1,6 @@ -{-# LANGUAGE DeriveFoldable #-} -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE GADTs #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TemplateHaskell #-} -- | -- Module : Pact.Types.Persistence @@ -115,7 +107,7 @@ timeCodec = Codec enc dec | otherwise = object [ highprec .= formatTime highPrecFormat t ] where denom :: UTCTime -> Integer - denom = denominator . (% 1000) . fromIntegral . toPosixTimestampMicros + denom = denominator . (% 1000000) . fromIntegral . toPosixTimestampMicros {-# INLINE enc #-} dec = withObject "time" $ \o -> (o .: field >>= mkTime pactISO8601Format) <|> diff --git a/tests/Test/Pact/Types/Codec.hs b/tests/Test/Pact/Types/Codec.hs new file mode 100644 index 000000000..7789fa6ef --- /dev/null +++ b/tests/Test/Pact/Types/Codec.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | +-- Module: Test.Pact.Types.Codec +-- Copyright: Copyright © 2022 Kadena LLC. +-- License: BSD-3 +-- Stability: experimental +-- +module Test.Pact.Types.Codec +( tests +) where + +import Data.Aeson +import Data.Aeson.Types +import qualified Data.HashMap.Strict as HM +import qualified Data.Text as T + +import Pact.Time + +import Test.Hspec +import Test.Hspec.QuickCheck +import Test.QuickCheck hiding (Success) + +-- internal modules + +import Pact.Types.Codec +import Pact.Types.Orphans () + +tests :: Spec +tests = describe "Codec" + spec_timeCodec + +spec_timeCodec :: Spec +spec_timeCodec = describe "timeCodec" $ do + prop "roundtrips" $ withMaxSuccess 10000 $ \t -> + parse (decoder timeCodec) (encoder timeCodec t) === Success t + + prop "% 1000000 roundtrips" $ \t -> do + let p = toPosixTimestampMicros t + let t' = fromPosixTimestampMicros $ 1000000 * (p `div` 1000000) + parse (decoder timeCodec) (encoder timeCodec t') === Success t' + + prop "% 1000 roundtrips" $ \t -> do + let p = toPosixTimestampMicros t + let t' = fromPosixTimestampMicros $ 1000 * (p `div` 1000) + parse (decoder timeCodec) (encoder timeCodec t') === Success t' + + prop "uses correct format" $ \t -> + let + isHighRes = toPosixTimestampMicros t `rem` 1000000 /= 0 + in + case encoder timeCodec t of + Object o + | isHighRes -> case HM.lookup "timep" o of + Just (String s) -> T.elem '.' s + _ -> error $ "timeCodec failed: " <> show o + | otherwise -> case HM.lookup "time" o of + Just (String s) -> not (T.elem '.' s) + _ -> error $ "timeCodec failed: " <> show o + x -> error $ "timeCodec failed: " <> show x +