Fix time codec

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:

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)
 

src/Pact/Types/Advice.hs

@@ -3,7 +3,6 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TemplateHaskell #-}
 
 -- |
 -- Module      :  Pact.Types.Advice

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) <|>

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
+